diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 21feba114..473f74b9a 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -13,6 +13,8 @@ import Control.Monad.Primitive newtype FBO = FBO {_unFBO :: GLuint} +newtype TO = TO {_unTO :: GLuint} + data RenderData = RenderData { _lightingWallShadShader :: FullShader , _lightingLineShadowShader :: FullShader @@ -33,22 +35,23 @@ data RenderData = RenderData , _shapeEBO :: EBO , _silhouetteEBO :: EBO , _pictureShaders :: MV.MVector (PrimState IO) FullShader - , _fbo2 :: (FBO, TextureObject) - , _fbo3 :: (FBO, TextureObject) - , _fboHalf1 :: (FBO, TextureObject) - , _fboHalf2 :: (FBO, TextureObject) - , _fboHalf3 :: (FBO, TextureObject) - , _fboBase :: (FBO, (TextureObject, TextureObject)) - , _fboCloud :: (FBO, (TextureObject, TextureObject)) - , _fboBloom :: (FBO, TextureObject) - , _fboColor :: (FBO, TextureObject) - , _fboPos :: (FBO, TextureObject) - , _fboLighting :: (FBO, TextureObject) - , _fboLightingHigh :: (FBO, TextureObject) - , _fboShadow :: (FBO, (TextureObject,TextureObject)) + , _fbo2 :: (FBO, TO) + , _fbo3 :: (FBO, TO) + , _fboHalf1 :: (FBO, TO) + , _fboHalf2 :: (FBO, TO) + , _fboHalf3 :: (FBO, TO) + , _fboBase :: (FBO, (TO, TO)) + , _fboCloud :: (FBO, (TO, TO)) + , _fboBloom :: (FBO, TO) + , _fboColor :: (FBO, TO) + , _fboPos :: (FBO, TO) + , _fboLighting :: (FBO, TO) + , _fboLightingHigh :: (FBO, TO) + , _fboShadow :: (FBO, (TO,TO)) , _rboBaseBloom :: GLuint -- RenderbufferObject id , _matUBO :: GLuint -- BufferObject id } makeLenses ''RenderData makeLenses ''FBO +makeLenses ''TO diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 8c9cd95a7..4d6068eee 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -167,7 +167,8 @@ doDrawing win pdata u = do --bindFramebuffer Framebuffer $= pdata ^. fboBase . _1 --fst (_fboBase pdata) glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO) --textureBinding Texture2D $= Just (snd $ _fboLighting pdata) - textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata) + --textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata) + glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO) -- Just (snd $ _fboLighting pdata) blend $= Enabled blendFunc $= (Zero, OneMinusSrcColor) drawShader (_fullscreenShader pdata) 4 @@ -187,7 +188,8 @@ doDrawing win pdata u = do --bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata) glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata))) depthFunc $= Just Always - textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata) + --textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata) + glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO) -- Just (snd $ _fboBloom pdata) blend $= Disabled drawShader (_bloomBlurShader pdata) 4 replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata) @@ -238,7 +240,8 @@ doDrawing win pdata u = do depthMask $= Disabled drawBuffers $= [FBOColorAttachment 0, NoBuffers] depthFunc $= Just Always - textureBinding Texture2D $= Just (snd $ _fboLighting pdata) + --textureBinding Texture2D $= Just (snd $ _fboLighting pdata) + glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata) blend $= Enabled --blendFunc $= (Zero, OneMinusSrcAlpha) blendFuncSeparate $= ((Zero, OneMinusSrcColor), (Zero, One)) @@ -250,11 +253,13 @@ doDrawing win pdata u = do --Draw blurred bloom onto base buffer blend $= Enabled blendFunc $= (SrcAlpha, One) - textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata) + --textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata) + glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata) drawShader (_fullscreenShader pdata) 4 blendFunc $= (SrcAlpha, OneMinusSrcAlpha) --draw shadowed clouds onto base buffer - textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata) + --textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata) + glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata) drawShader (_fullscreenShader pdata) 4 --set viewport for radial distortion setViewportSize (round winx) (round winy) diff --git a/src/Framebuffer/Setup.hs b/src/Framebuffer/Setup.hs index 32400d636..34077aee3 100644 --- a/src/Framebuffer/Setup.hs +++ b/src/Framebuffer/Setup.hs @@ -6,6 +6,7 @@ module Framebuffer.Setup ( setupShadowFramebuffer, ) where +import Unsafe.Coerce import Data.Preload.Render import GLHelp import Graphics.GL.Core45 @@ -14,68 +15,75 @@ import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate) setupTextureFramebuffer :: GLsizei -> GLsizei -> - IO (FBO, TextureObject) + IO (FBO, TO) {-# INLINE setupTextureFramebuffer #-} setupTextureFramebuffer x y = do --fboName <- genObjectName --bindFramebuffer Framebuffer $= fboName - fboName <- mglCreateSingle glCreateFramebuffers - fboTO <- genObjectName - textureBinding Texture2D $= Just fboTO - glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y - textureFilter Texture2D $= minMagFilter + fboName <- mglCreate glCreateFramebuffers + --fboTO <- genObjectName + to <- mglCreate (glCreateTextures GL_TEXTURE_2D) + --textureBinding Texture2D $= Just fboTO + --glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y + glTextureStorage2D to 1 GL_RGBA8 x y + glTextureParameteri to GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST) + glTextureParameteri to GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST) + --textureFilter Texture2D $= minMagFilter --framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 - glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 (unTexture fboTO) 0 + glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 to 0 fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () _ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus - return (FBO fboName, fboTO) + return (FBO fboName, TO to) -setupShadowFramebuffer :: IO (FBO, (TextureObject, TextureObject)) +setupShadowFramebuffer :: IO (FBO, (TO, TO)) setupShadowFramebuffer = do --fboName <- genObjectName --bindFramebuffer Framebuffer $= fboName - fboName <- mglCreateSingle glCreateFramebuffers - toName <- genObjectName - toName2 <- genObjectName + fboName <- mglCreate glCreateFramebuffers + to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY) + to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY) --textureBinding Texture2DArray $= Just toName --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName - return (FBO fboName, (toName, toName2)) + return (FBO fboName, (TO to1,TO to2)) setupFramebufferGivenStencil :: GLuint -> -- RenderbufferObject - IO (FBO, TextureObject) + IO (FBO, TO) {-# INLINE setupFramebufferGivenStencil #-} setupFramebufferGivenStencil rboName = do --fboName <- genObjectName --bindFramebuffer Framebuffer $= fboName - fboName <- mglCreateSingle glCreateFramebuffers - toName <- genObjectName + fboName <- mglCreate glCreateFramebuffers + --toName <- genObjectName + to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D) --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () _ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus - return (FBO fboName, toName) + return (FBO fboName, TO to1) setupFramebuffer2GivenStencil :: GLuint -> -- RenderbufferObject - IO (FBO, (TextureObject, TextureObject)) + IO (FBO, (TO, TO)) setupFramebuffer2GivenStencil rboName = do --fboName <- genObjectName --bindFramebuffer Framebuffer $= fboName - fboName <- mglCreateSingle glCreateFramebuffers - toName <- genObjectName - toName2 <- genObjectName + fboName <- mglCreate glCreateFramebuffers +-- toName <- genObjectName +-- toName2 <- genObjectName + to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D) + to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D) --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () _ -> putStrLn $ "Framebuffer with given stencil and two texture objects status: " ++ show fboStatus - return (FBO fboName, (toName, toName2)) + return (FBO fboName, (TO to1, TO to2)) minMagFilter :: ((TextureFilter, Maybe TextureFilter), TextureFilter) minMagFilter = ((Nearest, Nothing), Nearest) diff --git a/src/Framebuffer/Update.hs b/src/Framebuffer/Update.hs index b24229d83..4d2d17a19 100644 --- a/src/Framebuffer/Update.hs +++ b/src/Framebuffer/Update.hs @@ -8,6 +8,8 @@ module Framebuffer.Update where import Data.Preload.Render import GLHelp +import Unsafe.Coerce +import Foreign.Marshal.Array import Graphics.Rendering.OpenGL import Graphics.GL.Core45 @@ -24,14 +26,14 @@ sizeFBOs -> IO RenderData sizeFBOs xsize ysize xfull yfull rdata = do resizeRBO (_rboBaseBloom rdata) xsize ysize - rdata' <- foldM (updateFBOTO2 xsize ysize minMagFilter GL_RGBA8 GL_RGBA16F) rdata [fboBase,fboCloud] - >>= flip (foldM (updateFBOTO xsize ysize minMagFilter GL_RGBA8)) + rdata' <- foldM (updateFBOTO2 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F) rdata [fboBase,fboCloud] + >>= flip (foldM (updateFBOTO xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8)) [fboColor,fboLighting,fboLightingHigh] - rdata'' <- foldM (updateFBOTO xsize ysize linMinMagFilter GL_RGBA16F) rdata' + rdata'' <- foldM (updateFBOTO xsize ysize GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata' [fboBloom, fboPos] - rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata'' + rdata''' <- foldM (updateFBOTO xfull yfull GL_NEAREST GL_NEAREST GL_RGBA8) rdata'' [fbo2, fbo3] - rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata''' + rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata''' [fboHalf1,fboHalf2,fboHalf3] newShadowFBO <- resizeShadowFBO (rdata ^. fboShadow) xsize ysize return $ rdata4 & fboShadow .~ newShadowFBO @@ -53,111 +55,142 @@ resizeRBO rboName xsize ysize = do updateFBOTO :: Int -> Int - -> ((TextureFilter, Maybe TextureFilter),TextureFilter) + -> GLenum -- ^ minification filter + -> GLenum -- ^ magnification filter -> GLenum -- ^ internal color format -> RenderData - -> ALens' RenderData (FBO, TextureObject) + -> ALens' RenderData (FBO, TO) -> IO RenderData -updateFBOTO xsize ysize mmfilt inFormat pdata target = do - newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat +updateFBOTO xsize ysize minfilt magfilt inFormat pdata target = do + newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize minfilt magfilt inFormat return $ storing target newfbo2 pdata updateFBOTO2 :: Int -> Int - -> ((TextureFilter, Maybe TextureFilter),TextureFilter) + -> GLenum -- ^ minification filter + -> GLenum -- ^ magnification filter -> GLenum -- ^ internal color format texture1 -> GLenum -- ^ internal color format texture2 -> RenderData - -> ALens' RenderData (FBO, (TextureObject,TextureObject)) + -> ALens' RenderData (FBO, (TO,TO)) -> IO RenderData -updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do - newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2 +updateFBOTO2 xsize ysize minfilt magfilt inFormat1 inFormat2 pdata target = do + newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2 return $ storing target newfbo2 pdata -- note we only really "change" the texture objects -resizeShadowFBO :: (FBO, (TextureObject,TextureObject)) - -> Int -> Int -> IO (FBO, (TextureObject,TextureObject)) +resizeShadowFBO :: (FBO, (TO,TO)) + -> Int -> Int -> IO (FBO, (TO,TO)) resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do let xsize' = fromIntegral xsize ysize' = fromIntegral ysize --bindFramebuffer Framebuffer $= fboname glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboname) - deleteObjectName oldto1 - deleteObjectName oldto2 - to1 <- genObjectName - to2 <- genObjectName - textureBinding Texture2DArray $= Just to1 - glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10 - textureFilter Texture2DArray $= minMagFilter - glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 (unTexture to1) 0 - textureBinding Texture2DArray $= Just to2 - glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10 - textureFilter Texture2DArray $= minMagFilter - glNamedFramebufferTexture (_unFBO fboname) GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0 + mglDelete glDeleteTextures $ _unTO oldto1 + mglDelete glDeleteTextures $ _unTO oldto2 + --deleteObjectName oldto1 + --deleteObjectName oldto2 + --to1 <- genObjectName + --to2 <- genObjectName + to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY) + to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY) + --textureBinding Texture2DArray $= Just to1 + glTextureStorage3D to1 1 GL_RGBA8 xsize' ysize' 10 + glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST) + glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST) + --textureFilter Texture2DArray $= minMagFilter + glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 to1 0 + --textureBinding Texture2DArray $= Just to2 + glTextureStorage3D to2 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10 + glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST) + glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST) + --textureFilter Texture2DArray $= minMagFilter + glNamedFramebufferTexture (_unFBO fboname) GL_DEPTH_STENCIL_ATTACHMENT to2 0 fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus - return (fboname,(to1,to2)) + return (fboname,(TO to1,TO to2)) +-- this currently has one mipmap level? resizeFBOTO2 - :: (FBO , (TextureObject,TextureObject)) + :: (FBO , (TO,TO)) -> Int -> Int - -> ((TextureFilter, Maybe TextureFilter),TextureFilter) + -> GLenum -- ^ minification filter + -> GLenum -- ^ magnification filter -> GLenum -- ^ internal color format1 -> GLenum -- ^ internal color format2 - -> IO (FBO, (TextureObject,TextureObject)) -resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 = do + -> IO (FBO, (TO,TO)) +resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize minfilt magfilt inFormat1 inFormat2 = do --bindFramebuffer Framebuffer $= fboName glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName) let xsize' = fromIntegral xsize ysize' = fromIntegral ysize - deleteObjectName toOld1 - deleteObjectName toOld2 - toName1 <- genObjectName - textureBinding Texture2D $= Just toName1 - glTexStorage2D GL_TEXTURE_2D 1 inFormat1 xsize' ysize' - textureFilter Texture2D $= mmfilt - framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName1 0 - toName2 <- genObjectName - textureBinding Texture2D $= Just toName2 - glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize' - textureFilter Texture2D $= mmfilt + mglDelete glDeleteTextures $ _unTO toOld1 + mglDelete glDeleteTextures $ _unTO toOld2 +-- deleteObjectName toOld1 +-- deleteObjectName toOld2 + to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D) + to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D) + --toName1 <- genObjectName + --textureBinding Texture2D $= Just toName1 + --glTexStorage2D GL_TEXTURE_2D 1 inFormat1 xsize' ysize' + glTextureStorage2D to1 1 inFormat1 xsize' ysize' + glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt) + glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt) + --textureFilter Texture2D $= mmfilt + glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 to1 0 + --framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName1 0 + glTextureStorage2D to2 1 inFormat2 xsize' ysize' + glTextureParameteri to2 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt) + glTextureParameteri to2 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt) + --toName2 <- genObjectName + --textureBinding Texture2D $= Just toName2 + --glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize' + --textureFilter Texture2D $= mmfilt --framebufferTexture2D Framebuffer (ColorAttachment 1) Texture2D toName2 0 - glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT1 (unTexture toName2) 0 - drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1] + glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT1 to2 0 + withArray [GL_COLOR_ATTACHMENT0,GL_COLOR_ATTACHMENT1] $ \ptr -> + glNamedFramebufferDrawBuffers (_unFBO fboName) 2 ptr + --drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1] fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus - return (fboName, (toName1,toName2)) + return (fboName, (TO to1,TO to2)) resizeFBOTO - :: (FBO , TextureObject) + :: (FBO , TO) -> Int -> Int - -> ((TextureFilter, Maybe TextureFilter),TextureFilter) + -> GLenum -- ^ minification filter + --((TextureFilter, Maybe TextureFilter),TextureFilter) + -> GLenum -- ^ magnification filter -> GLenum -- ^ internal color format - -> IO (FBO, TextureObject) -resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do + -> IO (FBO, TO) +resizeFBOTO (fboName,oldto) xsize ysize minfilt magfilt inFormat = do --bindFramebuffer Framebuffer $= fboName glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName) let xsize' = fromIntegral xsize ysize' = fromIntegral ysize - deleteObjectName toOld - toName <- genObjectName - textureBinding Texture2D $= Just toName - glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize' - textureFilter Texture2D $= mmfilt - glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 (unTexture toName) 0 + mglDelete glDeleteTextures $ _unTO oldto + to <- mglCreate (glCreateTextures GL_TEXTURE_2D) + --toName <- genObjectName + --textureBinding Texture2D $= Just toName + --glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize' + glTextureStorage2D to 1 inFormat xsize' ysize' + glTextureParameteri to GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt) + glTextureParameteri to GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt) + --textureFilter Texture2D $= mmfilt + glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 to 0 --framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0 fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () _ -> error $ "after resize, resizeFBOTO framebuffer status:" ++ show fboStatus - return (fboName, toName) + return (fboName, TO to) minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter) minMagFilter = ((Nearest,Nothing),Nearest) diff --git a/src/GLHelp.hs b/src/GLHelp.hs index 3d8c7ca75..54e893bba 100644 --- a/src/GLHelp.hs +++ b/src/GLHelp.hs @@ -5,13 +5,15 @@ import Foreign.Storable import Graphics.GL.Core45 import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate) - -mglCreateSingle :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint -mglCreateSingle f = do +mglCreate :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint +mglCreate f = do alloca $ \nameptr -> do f 1 nameptr peek nameptr +mglDelete :: (GLsizei -> Ptr GLuint -> IO ()) -> GLuint -> IO () +mglDelete f i = with i $ \ptr -> f 1 ptr + unTexture :: TextureObject -> GLuint unTexture (TextureObject t) = t diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index edd8b2e30..bea46b152 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -27,11 +27,11 @@ numDrawableWalls = 5000 preloadRender :: IO RenderData preloadRender = do -- set up uniform buffer object - theUBO <- mglCreateSingle glCreateBuffers + theUBO <- mglCreate glCreateBuffers glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO -- setup wall points VBO, VAOs and shaders - wpVBOname <- mglCreateSingle glCreateBuffers + wpVBOname <- mglCreate glCreateBuffers wpVBOptr <- mallocArray (8 * numDrawableWalls) glNamedBufferData wpVBOname ( fromIntegral $ floatSize * numDrawableWalls * 8) @@ -40,19 +40,19 @@ preloadRender = do let wpVBO = VBO{_vboName = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} -- wpVAOname <- genObjectName -- bindVertexArrayObject $= Just wpVAOname - wpVAOname <- mglCreateSingle glCreateVertexArrays + wpVAOname <- mglCreate glCreateVertexArrays glBindVertexArray wpVAOname setupVertexAttribPointer wpVAOname wpVBOname 0 4 8 0 --wpColVAOname <- genObjectName --bindVertexArrayObject $= Just wpColVAOname - wpColVAOname <- mglCreateSingle glCreateVertexArrays + wpColVAOname <- mglCreate glCreateVertexArrays glBindVertexArray wpColVAOname setupVertexAttribPointer wpColVAOname wpVBOname 0 4 8 0 setupVertexAttribPointer wpColVAOname wpVBOname 1 4 8 4 let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO} wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO} -- setup window points VBO, VAOs and shaders - winVBOname <- mglCreateSingle glCreateBuffers + winVBOname <- mglCreate glCreateBuffers winVBOptr <- mallocArray (8 * numDrawableWalls) glNamedBufferData wpVBOname ( fromIntegral $ floatSize * numDrawableWalls * 8) @@ -61,21 +61,21 @@ preloadRender = do let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} --winColVAOname <- genObjectName --bindVertexArrayObject $= Just winColVAOname - winColVAOname <- mglCreateSingle glCreateVertexArrays + winColVAOname <- mglCreate glCreateVertexArrays glBindVertexArray winColVAOname setupVertexAttribPointer winColVAOname winVBOname 0 4 8 0 setupVertexAttribPointer winColVAOname winVBOname 1 4 8 4 let winColVAO = VAO{_vaoName = winColVAOname, _vaoVBO = winVBO} -- setup shape geometry/cap VBO and two VAOs shEBOptr <- mallocArray numDrawableElements - shEBOname <- mglCreateSingle glCreateBuffers + shEBOname <- mglCreate glCreateBuffers glNamedBufferData shEBOname ( fromIntegral $ glushortSize * numDrawableElements) nullPtr GL_STREAM_DRAW let shEBO = EBO{_eboName = shEBOname, _eboPtr = shEBOptr} - shVBOname <- mglCreateSingle glCreateBuffers + shVBOname <- mglCreate glCreateBuffers shVBOptr <- mallocArray (7 * numDrawableElements) glNamedBufferData shVBOname ( fromIntegral $ floatSize * numDrawableElements * 7) @@ -84,7 +84,7 @@ preloadRender = do let shVBO = VBO{_vboName = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} --shPosColVAOname <- genObjectName --bindVertexArrayObject $= Just shPosColVAOname - shPosColVAOname <- mglCreateSingle glCreateVertexArrays + shPosColVAOname <- mglCreate glCreateVertexArrays glBindVertexArray shPosColVAOname setupVertexAttribPointer shPosColVAOname shVBOname 0 3 7 0 setupVertexAttribPointer shPosColVAOname shVBOname 1 4 7 3 @@ -92,7 +92,7 @@ preloadRender = do glVertexArrayElementBuffer shPosColVAOname shEBOname --shPosVAOname <- genObjectName --bindVertexArrayObject $= Just shPosVAOname - shPosVAOname <- mglCreateSingle glCreateVertexArrays + shPosVAOname <- mglCreate glCreateVertexArrays glBindVertexArray shPosVAOname setupVertexAttribPointer shPosVAOname shVBOname 0 3 7 0 --bindBuffer ElementArrayBuffer $= Just shEBOname @@ -102,11 +102,11 @@ preloadRender = do --setup silhouette edge VAO --shEdgeVAOname <- genObjectName --bindVertexArrayObject $= Just shEdgeVAOname - shEdgeVAOname <- mglCreateSingle glCreateVertexArrays + shEdgeVAOname <- mglCreate glCreateVertexArrays glBindVertexArray shEdgeVAOname setupVertexAttribPointer shEdgeVAOname shVBOname 0 3 7 0 --setup ebo for silhouette edges - silEBOname <- mglCreateSingle glCreateBuffers + silEBOname <- mglCreate glCreateBuffers silEBOptr <- mallocArray numDrawableElements -- it may be important to bind this while the correct VAO is bound glVertexArrayElementBuffer shEdgeVAOname silEBOname @@ -175,7 +175,7 @@ preloadRender = do framebuf2 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600 - rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers + rboBaseBloomName <- mglCreate glCreateRenderbuffers glNamedRenderbufferStorage rboBaseBloomName GL_DEPTH24_STENCIL8 diff --git a/src/Render.hs b/src/Render.hs index 2e43877a6..fd12699e9 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -45,7 +45,7 @@ createLightMap :: -- | whether to draw object shadows or not ObjectShadows -> -- | the texture object giving positions - TextureObject -> + TO -> (Point3 -> Float -> IO ()) -> -- attempt at drawing shadow not using geo shader IO () createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUShadows = do @@ -143,18 +143,20 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh -- assumes that vertices have already been sent to the shader pingPongBetween :: - (FBO, TextureObject) -> - (FBO, TextureObject) -> + (FBO, TO) -> + (FBO, TO) -> FullShader -> IO () pingPongBetween (fb1, to1) (fb2, to2) fs = do --bindFramebuffer Framebuffer $= fb2 glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2) - textureBinding Texture2D $= Just to1 + --textureBinding Texture2D $= Just to1 + glBindTexture GL_TEXTURE_2D (_unTO to1) drawShader fs 4 --bindFramebuffer Framebuffer $= fb1 glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1) - textureBinding Texture2D $= Just to2 + --textureBinding Texture2D $= Just to2 + glBindTexture GL_TEXTURE_2D (_unTO to2) drawShader fs 4 renderFoldable :: @@ -178,8 +180,9 @@ renderLayer layer shads counts = do where ln = layerNum layer -bindTO :: TextureObject -> IO () -bindTO t = textureBinding Texture2D $= Just t +bindTO :: TO -> IO () +bindTO t = glBindTexture GL_TEXTURE_2D (_unTO t) + --textureBinding Texture2D $= Just t bindFBO :: FBO -> IO () bindFBO fb = --bindFramebuffer Framebuffer $= fb diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index f27dad943..d4c8a2b85 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -38,7 +38,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do let texdata = convertRGBA8 cmap let wtex = fromIntegral $ imageWidth texdata htex = fromIntegral $ imageHeight texdata - texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D + texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D glTextureStorage2D texname nlev GL_RGBA8 wtex htex VS.unsafeWith (imageData texdata) $ \ptr -> do glTextureSubImage2D texname 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr @@ -69,7 +69,7 @@ addTextureArray texturePath shad = do print err Right cmap <- readImage texturePath let texdata = convertRGBA8 cmap - texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D_ARRAY + texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY glTextureStorage3D texname 3 GL_RGBA8 32 32 64 VS.unsafeWith (imageData texdata) $ \ptr -> do glTextureSubImage3D texname 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 432f080f5..c418c0e9d 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -129,7 +129,7 @@ setupVAO = setupVAOSized numDrawableElements setupVAOSized :: Int -> [Int] -> IO VAO setupVAOSized ndraw sizes = do - vaoname <- mglCreateSingle glCreateVertexArrays + vaoname <- mglCreate glCreateVertexArrays glBindVertexArray vaoname theVBO <- setupVBOSized ndraw vaoname sizes return $ @@ -142,7 +142,7 @@ setupVBOSized :: Int -> GLuint -> [Int] -> IO VBO setupVBOSized ndraw vao sizes = do --vboName <- genObjectName --bindBuffer ArrayBuffer $= Just vboName - vboname <- mglCreateSingle glCreateBuffers + vboname <- mglCreate glCreateBuffers glBindBuffer GL_ARRAY_BUFFER vboname forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do setupVertexAttribPointer vao vboname loc siz strd off