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

Move FBOs to opengl raw

Browse Source
This commit is contained in:
justin
2023-03-09 15:42:17 +00:00
parent 76a8b05433
commit 44b56ed163
7 changed files with 121 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+19 -16
View File
@@ -11,6 +11,8 @@ import Control.Lens
import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Mutable as MV
import Control.Monad.Primitive import Control.Monad.Primitive
newtype FBO = FBO {_unFBO :: GLuint}
data RenderData = RenderData data RenderData = RenderData
{ _lightingWallShadShader :: FullShader { _lightingWallShadShader :: FullShader
, _lightingLineShadowShader :: FullShader , _lightingLineShadowShader :: FullShader
@@ -30,22 +32,23 @@ data RenderData = RenderData
, _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 :: (FBO, TextureObject)
, _fbo3 :: (FramebufferObject, TextureObject) , _fbo3 :: (FBO, TextureObject)
, _fboHalf1 :: (FramebufferObject, TextureObject) , _fboHalf1 :: (FBO, TextureObject)
, _fboHalf2 :: (FramebufferObject, TextureObject) , _fboHalf2 :: (FBO, TextureObject)
, _fboHalf3 :: (FramebufferObject, TextureObject) , _fboHalf3 :: (FBO, TextureObject)
, _fboBase :: (FramebufferObject, (TextureObject, TextureObject)) , _fboBase :: (FBO, (TextureObject, TextureObject))
, _fboCloud :: (FramebufferObject, (TextureObject, TextureObject)) , _fboCloud :: (FBO, (TextureObject, TextureObject))
, _fboBloom :: (FramebufferObject, TextureObject) , _fboBloom :: (FBO, TextureObject)
, _fboColor :: (FramebufferObject, TextureObject) , _fboColor :: (FBO, TextureObject)
, _fboPos :: (FramebufferObject, TextureObject) , _fboPos :: (FBO, TextureObject)
, _rboBaseBloom :: GLuint -- RenderbufferObject id , _fboLighting :: (FBO, TextureObject)
, _fboLighting :: (FramebufferObject, TextureObject) , _fboLightingHigh :: (FBO, TextureObject)
, _fboLightingHigh :: (FramebufferObject, TextureObject) , _fboShadow :: (FBO, (TextureObject,TextureObject))
, _fboShadow :: (FramebufferObject, (TextureObject,TextureObject)) , _rboBaseBloom :: GLuint -- RenderbufferObject id
, _matUBO :: GLuint -- BufferObject id , _matUBO :: GLuint -- BufferObject id
} }
makeLenses ''RenderData makeLenses ''RenderData
makeLenses ''FBO
src/Dodge/Render.hs
+20 -10
View File
@@ -111,7 +111,8 @@ doDrawing win pdata u = do
-- set the coordinate uniform ready for drawing elements using world coordinates -- set the coordinate uniform ready for drawing elements using world coordinates
bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
setViewportSize (round winx `div` resFact) (round winy `div` resFact) setViewportSize (round winx `div` resFact) (round winy `div` resFact)
bindFramebuffer Framebuffer $= fst (_fboBase pdata) --bindFramebuffer Framebuffer $= fst (_fboBase pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
clearColor $= Color4 0 0 0 0 clearColor $= Color4 0 0 0 0
clear [ColorBuffer, DepthBuffer] clear [ColorBuffer, DepthBuffer]
depthFunc $= Just Less depthFunc $= Just Less
@@ -148,7 +149,8 @@ doDrawing win pdata u = do
-- nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w) -- nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w)
drawShader (_textureArrayShader pdata) nFls drawShader (_textureArrayShader pdata) nFls
--draw lightmap into its own buffer --draw lightmap into its own buffer
bindFramebuffer Framebuffer $= fst (_fboLighting pdata) --bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap createLightMap
pdata pdata
lightPoints lightPoints
@@ -162,14 +164,16 @@ doDrawing win pdata u = do
colorMask $= Color4 Enabled Enabled Enabled Enabled colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0 clearColor $= Color4 0 0 0 0
--apply lightmap to base buffer --apply lightmap to base buffer
bindFramebuffer Framebuffer $= pdata ^. fboBase . _1 --fst (_fboBase pdata) --bindFramebuffer Framebuffer $= pdata ^. fboBase . _1 --fst (_fboBase pdata)
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
--textureBinding Texture2D $= Just (snd $ _fboLighting pdata) --textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata) textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata)
blend $= Enabled blend $= Enabled
blendFunc $= (Zero, OneMinusSrcColor) blendFunc $= (Zero, OneMinusSrcColor)
drawShader (_fullscreenShader pdata) 4 drawShader (_fullscreenShader pdata) 4
--draw bloom onto bloom buffer --draw bloom onto bloom buffer
bindFramebuffer Framebuffer $= pdata ^. fboBloom . _1 --fst (_fboBloom pdata) --bindFramebuffer Framebuffer $= pdata ^. fboBloom . _1 --fst (_fboBloom pdata)
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
clear [ColorBuffer] clear [ColorBuffer]
depthFunc $= Just Less depthFunc $= Just Less
blendFunc $= (SrcAlpha, OneMinusSrcAlpha) blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
@@ -180,7 +184,8 @@ doDrawing win pdata u = do
--depthMask $= Enabled --depthMask $= Enabled
--setup downscale viewport for blurring bloom --setup downscale viewport for blurring bloom
setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact)) setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata) --bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
depthFunc $= Just Always depthFunc $= Just Always
textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata) textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
blend $= Disabled blend $= Disabled
@@ -189,7 +194,8 @@ doDrawing win pdata u = do
blend $= Enabled blend $= Enabled
setViewportSize (round winx `div` resFact) (round winy `div` resFact) setViewportSize (round winx `div` resFact) (round winy `div` resFact)
--draw clouds onto cloud buffer --draw clouds onto cloud buffer
bindFramebuffer Framebuffer $= fst (_fboCloud pdata) --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
depthFunc $= Just Lequal depthFunc $= Just Lequal
depthMask $= Disabled depthMask $= Disabled
clearColor $= Color4 0.5 0.5 0.5 0 clearColor $= Color4 0.5 0.5 0.5 0
@@ -212,7 +218,8 @@ doDrawing win pdata u = do
----draw lightmap for cloud buffer ----draw lightmap for cloud buffer
depthMask $= Disabled depthMask $= Disabled
blend $= Enabled blend $= Enabled
bindFramebuffer Framebuffer $= fst (_fboLighting pdata) --bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap createLightMap
pdata pdata
lightPoints lightPoints
@@ -226,7 +233,8 @@ doDrawing win pdata u = do
clearColor $= Color4 0 0 0 0 clearColor $= Color4 0 0 0 0
--apply lightmap to cloud buffer --apply lightmap to cloud buffer
clearColor $= Color4 0 0 0 0 clearColor $= Color4 0 0 0 0
bindFramebuffer Framebuffer $= fst (_fboCloud pdata) --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
depthMask $= Disabled depthMask $= Disabled
drawBuffers $= [FBOColorAttachment 0, NoBuffers] drawBuffers $= [FBOColorAttachment 0, NoBuffers]
depthFunc $= Just Always depthFunc $= Just Always
@@ -237,7 +245,8 @@ doDrawing win pdata u = do
drawShader (_fullscreenShader pdata) 4 drawShader (_fullscreenShader pdata) 4
blendFunc $= (SrcAlpha, OneMinusSrcAlpha) blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
-- bind base buffer for drawing bloom then clouds -- bind base buffer for drawing bloom then clouds
bindFramebuffer Framebuffer $= fst (_fboBase pdata) --bindFramebuffer Framebuffer $= fst (_fboBase pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
--Draw blurred bloom onto base buffer --Draw blurred bloom onto base buffer
blend $= Enabled blend $= Enabled
blendFunc $= (SrcAlpha, One) blendFunc $= (SrcAlpha, One)
@@ -266,7 +275,8 @@ doDrawing win pdata u = do
drawShader (_barrelShader pdata) 1 drawShader (_barrelShader pdata) 1
fboList = fboList =
take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata])) take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
++ [defaultFramebufferObject] -- ++ [defaultFramebufferObject]
++ [FBO 0]
toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata]) toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList) bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
activeTexture $= TextureUnit 1 activeTexture $= TextureUnit 1
src/Framebuffer/Setup.hs
+46 -39
View File
@@ -1,74 +1,81 @@
{- | For initialising framebuffers. -- | For initialising framebuffers.
-} module Framebuffer.Setup (
module Framebuffer.Setup setupTextureFramebuffer,
( setupTextureFramebuffer setupFramebufferGivenStencil,
, setupFramebufferGivenStencil setupFramebuffer2GivenStencil,
, setupFramebuffer2GivenStencil setupShadowFramebuffer,
, setupShadowFramebuffer ) where
) where
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43
setupTextureFramebuffer import Data.Preload.Render
:: GLsizei import GLHelp
-> GLsizei import Graphics.GL.Core45
-> IO (FramebufferObject, TextureObject) import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
setupTextureFramebuffer ::
GLsizei ->
GLsizei ->
IO (FBO, TextureObject)
{-# INLINE setupTextureFramebuffer #-} {-# INLINE setupTextureFramebuffer #-}
setupTextureFramebuffer x y = do setupTextureFramebuffer x y = do
fboName <- genObjectName --fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName --bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
fboTO <- genObjectName fboTO <- genObjectName
textureBinding Texture2D $= Just fboTO textureBinding Texture2D $= Just fboTO
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y
textureFilter Texture2D $= minMagFilter textureFilter Texture2D $= minMagFilter
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 --framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 (unTexture fboTO) 0
fboStatus <- framebufferStatus Framebuffer fboStatus <- framebufferStatus Framebuffer
case fboStatus of case fboStatus of
Complete -> return () Complete -> return ()
_ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus _ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
return (fboName, fboTO) return (FBO fboName, fboTO)
setupShadowFramebuffer :: IO (FramebufferObject,(TextureObject,TextureObject)) setupShadowFramebuffer :: IO (FBO, (TextureObject, TextureObject))
setupShadowFramebuffer = do setupShadowFramebuffer = do
fboName <- genObjectName --fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName --bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName toName <- genObjectName
toName2 <- genObjectName toName2 <- genObjectName
--textureBinding Texture2DArray $= Just toName --textureBinding Texture2DArray $= Just toName
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
return (fboName,(toName,toName2)) return (FBO fboName, (toName, toName2))
setupFramebufferGivenStencil setupFramebufferGivenStencil ::
:: GLuint -- RenderbufferObject GLuint -> -- RenderbufferObject
-> IO (FramebufferObject, TextureObject) IO (FBO, TextureObject)
{-# INLINE setupFramebufferGivenStencil #-} {-# INLINE setupFramebufferGivenStencil #-}
setupFramebufferGivenStencil rboName = do setupFramebufferGivenStencil rboName = do
fboName <- genObjectName --fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName --bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName toName <- genObjectName
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
glFramebufferRenderbuffer GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName glNamedFramebufferRenderbuffer fboName 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 (FBO fboName, toName)
setupFramebuffer2GivenStencil
:: GLuint -- RenderbufferObject setupFramebuffer2GivenStencil ::
-> IO (FramebufferObject, (TextureObject,TextureObject)) GLuint -> -- RenderbufferObject
IO (FBO, (TextureObject, TextureObject))
setupFramebuffer2GivenStencil rboName = do setupFramebuffer2GivenStencil rboName = do
fboName <- genObjectName --fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName --bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
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 glNamedFramebufferRenderbuffer fboName 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 and two texture objects status: " ++ show fboStatus _ -> putStrLn $ "Framebuffer with given stencil and two texture objects status: " ++ show fboStatus
return (fboName,(toName,toName2)) return (FBO fboName, (toName, toName2))
minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter) minMagFilter :: ((TextureFilter, Maybe TextureFilter), TextureFilter)
minMagFilter = ((Nearest,Nothing),Nearest) minMagFilter = ((Nearest, Nothing), Nearest)
src/Framebuffer/Update.hs
+22 -20
View File
@@ -7,6 +7,7 @@ module Framebuffer.Update
) )
where where
import Data.Preload.Render import Data.Preload.Render
import GLHelp
import Graphics.Rendering.OpenGL import Graphics.Rendering.OpenGL
import Graphics.GL.Core45 import Graphics.GL.Core45
@@ -44,8 +45,6 @@ resizeRBO
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
--renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
glNamedRenderbufferStorage glNamedRenderbufferStorage
rboName rboName
GL_DEPTH24_STENCIL8 GL_DEPTH24_STENCIL8
@@ -57,7 +56,7 @@ updateFBOTO
-> ((TextureFilter, Maybe TextureFilter),TextureFilter) -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ internal color format -> GLenum -- ^ internal color format
-> RenderData -> RenderData
-> ALens' RenderData (FramebufferObject, TextureObject) -> ALens' RenderData (FBO, TextureObject)
-> IO RenderData -> IO RenderData
updateFBOTO xsize ysize mmfilt inFormat pdata target = do updateFBOTO xsize ysize mmfilt inFormat pdata target = do
newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat
@@ -70,18 +69,20 @@ updateFBOTO2
-> GLenum -- ^ internal color format texture1 -> GLenum -- ^ internal color format texture1
-> GLenum -- ^ internal color format texture2 -> GLenum -- ^ internal color format texture2
-> RenderData -> RenderData
-> ALens' RenderData (FramebufferObject, (TextureObject,TextureObject)) -> ALens' RenderData (FBO, (TextureObject,TextureObject))
-> IO RenderData -> IO RenderData
updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do
newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2 newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2
return $ storing target newfbo2 pdata return $ storing target newfbo2 pdata
resizeShadowFBO :: (FramebufferObject, (TextureObject,TextureObject)) -- note we only really "change" the texture objects
-> Int -> Int -> IO (FramebufferObject, (TextureObject,TextureObject)) resizeShadowFBO :: (FBO, (TextureObject,TextureObject))
-> Int -> Int -> IO (FBO, (TextureObject,TextureObject))
resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
let xsize' = fromIntegral xsize let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize ysize' = fromIntegral ysize
bindFramebuffer Framebuffer $= fboname --bindFramebuffer Framebuffer $= fboname
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboname)
deleteObjectName oldto1 deleteObjectName oldto1
deleteObjectName oldto2 deleteObjectName oldto2
to1 <- genObjectName to1 <- genObjectName
@@ -89,30 +90,28 @@ resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
textureBinding Texture2DArray $= Just to1 textureBinding Texture2DArray $= Just to1
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10 glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10
textureFilter Texture2DArray $= minMagFilter textureFilter Texture2DArray $= minMagFilter
glFramebufferTexture GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 (unTexture to1) 0 glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 (unTexture to1) 0
textureBinding Texture2DArray $= Just to2 textureBinding Texture2DArray $= Just to2
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10 glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
textureFilter Texture2DArray $= minMagFilter textureFilter Texture2DArray $= minMagFilter
glFramebufferTexture GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0 glNamedFramebufferTexture (_unFBO fboname) GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0
fboStatus <- framebufferStatus Framebuffer fboStatus <- framebufferStatus Framebuffer
case fboStatus of case fboStatus of
Complete -> return () Complete -> return ()
_ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
return (fboname,(to1,to2)) return (fboname,(to1,to2))
unTexture :: TextureObject -> GLuint
unTexture (TextureObject t) = t
resizeFBOTO2 resizeFBOTO2
:: (FramebufferObject , (TextureObject,TextureObject)) :: (FBO , (TextureObject,TextureObject))
-> Int -> Int
-> Int -> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter) -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ internal color format1 -> GLenum -- ^ internal color format1
-> GLenum -- ^ internal color format2 -> GLenum -- ^ internal color format2
-> IO (FramebufferObject, (TextureObject,TextureObject)) -> IO (FBO, (TextureObject,TextureObject))
resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 = do resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 = do
bindFramebuffer Framebuffer $= fboName --bindFramebuffer Framebuffer $= fboName
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
let xsize' = fromIntegral xsize let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize ysize' = fromIntegral ysize
deleteObjectName toOld1 deleteObjectName toOld1
@@ -126,7 +125,8 @@ resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 =
textureBinding Texture2D $= Just toName2 textureBinding Texture2D $= Just toName2
glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize' glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize'
textureFilter Texture2D $= mmfilt textureFilter Texture2D $= mmfilt
framebufferTexture2D Framebuffer (ColorAttachment 1) Texture2D toName2 0 --framebufferTexture2D Framebuffer (ColorAttachment 1) Texture2D toName2 0
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT1 (unTexture toName2) 0
drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1] drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1]
fboStatus <- framebufferStatus Framebuffer fboStatus <- framebufferStatus Framebuffer
case fboStatus of case fboStatus of
@@ -135,14 +135,15 @@ resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 =
return (fboName, (toName1,toName2)) return (fboName, (toName1,toName2))
resizeFBOTO resizeFBOTO
:: (FramebufferObject , TextureObject) :: (FBO , TextureObject)
-> Int -> Int
-> Int -> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter) -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ internal color format -> GLenum -- ^ internal color format
-> IO (FramebufferObject, TextureObject) -> IO (FBO, TextureObject)
resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
bindFramebuffer Framebuffer $= fboName --bindFramebuffer Framebuffer $= fboName
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
let xsize' = fromIntegral xsize let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize ysize' = fromIntegral ysize
deleteObjectName toOld deleteObjectName toOld
@@ -150,7 +151,8 @@ resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
textureBinding Texture2D $= Just toName textureBinding Texture2D $= Just toName
glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize' glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize'
textureFilter Texture2D $= mmfilt textureFilter Texture2D $= mmfilt
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0 glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 (unTexture toName) 0
--framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
fboStatus <- framebufferStatus Framebuffer fboStatus <- framebufferStatus Framebuffer
case fboStatus of case fboStatus of
Complete -> return () Complete -> return ()
src/GLHelp.hs
+5
View File
@@ -3,6 +3,7 @@ import Foreign.Ptr
import Foreign.Marshal import Foreign.Marshal
import Foreign.Storable import Foreign.Storable
import Graphics.GL.Core45 import Graphics.GL.Core45
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
mglCreateSingle :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint mglCreateSingle :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint
@@ -10,3 +11,7 @@ mglCreateSingle f = do
alloca $ \nameptr -> do alloca $ \nameptr -> do
f 1 nameptr f 1 nameptr
peek nameptr peek nameptr
unTexture :: TextureObject -> GLuint
unTexture (TextureObject t) = t
src/Preload/Render.hs
-2
View File
@@ -176,8 +176,6 @@ preloadRender = do
framebuf3 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600
rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers
--bindRenderbuffer Renderbuffer $= rboBaseBloomName
--renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
glNamedRenderbufferStorage glNamedRenderbufferStorage
rboBaseBloomName rboBaseBloomName
GL_DEPTH24_STENCIL8 GL_DEPTH24_STENCIL8
src/Render.hs
+9 -6
View File
@@ -143,15 +143,17 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
-- assumes that vertices have already been sent to the shader -- assumes that vertices have already been sent to the shader
pingPongBetween :: pingPongBetween ::
(FramebufferObject, TextureObject) -> (FBO, TextureObject) ->
(FramebufferObject, TextureObject) -> (FBO, 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
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2)
textureBinding Texture2D $= Just to1 textureBinding Texture2D $= Just to1
drawShader fs 4 drawShader fs 4
bindFramebuffer Framebuffer $= fb1 --bindFramebuffer Framebuffer $= fb1
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1)
textureBinding Texture2D $= Just to2 textureBinding Texture2D $= Just to2
drawShader fs 4 drawShader fs 4
@@ -179,5 +181,6 @@ renderLayer layer shads counts = do
bindTO :: TextureObject -> IO () bindTO :: TextureObject -> IO ()
bindTO t = textureBinding Texture2D $= Just t bindTO t = textureBinding Texture2D $= Just t
bindFBO :: FramebufferObject -> IO () bindFBO :: FBO -> IO ()
bindFBO fb = bindFramebuffer Framebuffer $= fb bindFBO fb = --bindFramebuffer Framebuffer $= fb
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb)