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 Control.Monad.Primitive
newtype FBO = FBO {_unFBO :: GLuint}
data RenderData = RenderData
{ _lightingWallShadShader :: FullShader
, _lightingLineShadowShader :: FullShader
@@ -30,22 +32,23 @@ data RenderData = RenderData
, _shapeShader :: FullShader
, _shapeEBO :: EBO
, _silhouetteEBO :: EBO
, _pictureShaders :: MV.MVector (PrimState IO) FullShader
, _fbo2 :: (FramebufferObject, TextureObject)
, _fbo3 :: (FramebufferObject, TextureObject)
, _fboHalf1 :: (FramebufferObject, TextureObject)
, _fboHalf2 :: (FramebufferObject, TextureObject)
, _fboHalf3 :: (FramebufferObject, TextureObject)
, _fboBase :: (FramebufferObject, (TextureObject, TextureObject))
, _fboCloud :: (FramebufferObject, (TextureObject, TextureObject))
, _fboBloom :: (FramebufferObject, TextureObject)
, _fboColor :: (FramebufferObject, TextureObject)
, _fboPos :: (FramebufferObject, TextureObject)
, _rboBaseBloom :: GLuint -- RenderbufferObject id
, _fboLighting :: (FramebufferObject, TextureObject)
, _fboLightingHigh :: (FramebufferObject, TextureObject)
, _fboShadow :: (FramebufferObject, (TextureObject,TextureObject))
, _matUBO :: GLuint -- BufferObject id
, _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))
, _rboBaseBloom :: GLuint -- RenderbufferObject id
, _matUBO :: GLuint -- BufferObject id
}
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
bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
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
clear [ColorBuffer, DepthBuffer]
depthFunc $= Just Less
@@ -148,7 +149,8 @@ doDrawing win pdata u = do
-- nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w)
drawShader (_textureArrayShader pdata) nFls
--draw lightmap into its own buffer
bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
--bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap
pdata
lightPoints
@@ -162,14 +164,16 @@ doDrawing win pdata u = do
colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0
--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 $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata)
blend $= Enabled
blendFunc $= (Zero, OneMinusSrcColor)
drawShader (_fullscreenShader pdata) 4
--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]
depthFunc $= Just Less
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
@@ -180,7 +184,8 @@ doDrawing win pdata u = do
--depthMask $= Enabled
--setup downscale viewport for blurring bloom
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
textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
blend $= Disabled
@@ -189,7 +194,8 @@ doDrawing win pdata u = do
blend $= Enabled
setViewportSize (round winx `div` resFact) (round winy `div` resFact)
--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
depthMask $= Disabled
clearColor $= Color4 0.5 0.5 0.5 0
@@ -212,7 +218,8 @@ doDrawing win pdata u = do
----draw lightmap for cloud buffer
depthMask $= Disabled
blend $= Enabled
bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
--bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap
pdata
lightPoints
@@ -226,7 +233,8 @@ doDrawing win pdata u = do
clearColor $= Color4 0 0 0 0
--apply lightmap to cloud buffer
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
drawBuffers $= [FBOColorAttachment 0, NoBuffers]
depthFunc $= Just Always
@@ -237,7 +245,8 @@ doDrawing win pdata u = do
drawShader (_fullscreenShader pdata) 4
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
-- 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
blend $= Enabled
blendFunc $= (SrcAlpha, One)
@@ -266,7 +275,8 @@ doDrawing win pdata u = do
drawShader (_barrelShader pdata) 1
fboList =
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])
bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
activeTexture $= TextureUnit 1
src/Framebuffer/Setup.hs
+46 -39
View File
@@ -1,74 +1,81 @@
{- | For initialising framebuffers.
-}
module Framebuffer.Setup
( setupTextureFramebuffer
, setupFramebufferGivenStencil
, setupFramebuffer2GivenStencil
, setupShadowFramebuffer
) where
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43
-- | For initialising framebuffers.
module Framebuffer.Setup (
setupTextureFramebuffer,
setupFramebufferGivenStencil,
setupFramebuffer2GivenStencil,
setupShadowFramebuffer,
) where
setupTextureFramebuffer
:: GLsizei
-> GLsizei
-> IO (FramebufferObject, TextureObject)
import Data.Preload.Render
import GLHelp
import Graphics.GL.Core45
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
setupTextureFramebuffer ::
GLsizei ->
GLsizei ->
IO (FBO, TextureObject)
{-# INLINE setupTextureFramebuffer #-}
setupTextureFramebuffer x y = do
fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName
--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
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
case fboStatus of
Complete -> return ()
_ -> 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
fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName
toName2 <- genObjectName
--textureBinding Texture2DArray $= Just toName
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
return (fboName,(toName,toName2))
return (FBO fboName, (toName, toName2))
setupFramebufferGivenStencil
:: GLuint -- RenderbufferObject
-> IO (FramebufferObject, TextureObject)
setupFramebufferGivenStencil ::
GLuint -> -- RenderbufferObject
IO (FBO, TextureObject)
{-# INLINE setupFramebufferGivenStencil #-}
setupFramebufferGivenStencil rboName = do
fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName
--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
case fboStatus of
Complete -> return ()
_ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
return (fboName,toName)
setupFramebuffer2GivenStencil
:: GLuint -- RenderbufferObject
-> IO (FramebufferObject, (TextureObject,TextureObject))
return (FBO fboName, toName)
setupFramebuffer2GivenStencil ::
GLuint -> -- RenderbufferObject
IO (FBO, (TextureObject, TextureObject))
setupFramebuffer2GivenStencil rboName = do
fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName
toName2 <- genObjectName
--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
case fboStatus of
Complete -> return ()
_ -> 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 = ((Nearest,Nothing),Nearest)
minMagFilter :: ((TextureFilter, Maybe TextureFilter), TextureFilter)
minMagFilter = ((Nearest, Nothing), Nearest)
src/Framebuffer/Update.hs
+22 -20
View File
@@ -7,6 +7,7 @@ module Framebuffer.Update
)
where
import Data.Preload.Render
import GLHelp
import Graphics.Rendering.OpenGL
import Graphics.GL.Core45
@@ -44,8 +45,6 @@ resizeRBO
resizeRBO rboName xsize ysize = do
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
--bindRenderbuffer Renderbuffer $= rboName
--renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
glNamedRenderbufferStorage
rboName
GL_DEPTH24_STENCIL8
@@ -57,7 +56,7 @@ updateFBOTO
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ internal color format
-> RenderData
-> ALens' RenderData (FramebufferObject, TextureObject)
-> ALens' RenderData (FBO, TextureObject)
-> IO RenderData
updateFBOTO xsize ysize mmfilt inFormat pdata target = do
newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat
@@ -70,18 +69,20 @@ updateFBOTO2
-> GLenum -- ^ internal color format texture1
-> GLenum -- ^ internal color format texture2
-> RenderData
-> ALens' RenderData (FramebufferObject, (TextureObject,TextureObject))
-> ALens' RenderData (FBO, (TextureObject,TextureObject))
-> IO RenderData
updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do
newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2
return $ storing target newfbo2 pdata
resizeShadowFBO :: (FramebufferObject, (TextureObject,TextureObject))
-> Int -> Int -> IO (FramebufferObject, (TextureObject,TextureObject))
-- note we only really "change" the texture objects
resizeShadowFBO :: (FBO, (TextureObject,TextureObject))
-> Int -> Int -> IO (FBO, (TextureObject,TextureObject))
resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
bindFramebuffer Framebuffer $= fboname
--bindFramebuffer Framebuffer $= fboname
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboname)
deleteObjectName oldto1
deleteObjectName oldto2
to1 <- genObjectName
@@ -89,30 +90,28 @@ resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
textureBinding Texture2DArray $= Just to1
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10
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
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
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
case fboStatus of
Complete -> return ()
_ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
return (fboname,(to1,to2))
unTexture :: TextureObject -> GLuint
unTexture (TextureObject t) = t
resizeFBOTO2
:: (FramebufferObject , (TextureObject,TextureObject))
:: (FBO , (TextureObject,TextureObject))
-> Int
-> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ internal color format1
-> GLenum -- ^ internal color format2
-> IO (FramebufferObject, (TextureObject,TextureObject))
-> IO (FBO, (TextureObject,TextureObject))
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
ysize' = fromIntegral ysize
deleteObjectName toOld1
@@ -126,7 +125,8 @@ resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 =
textureBinding Texture2D $= Just toName2
glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize'
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]
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
@@ -135,14 +135,15 @@ resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 =
return (fboName, (toName1,toName2))
resizeFBOTO
:: (FramebufferObject , TextureObject)
:: (FBO , TextureObject)
-> Int
-> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ internal color format
-> IO (FramebufferObject, TextureObject)
-> IO (FBO, TextureObject)
resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
bindFramebuffer Framebuffer $= fboName
--bindFramebuffer Framebuffer $= fboName
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
deleteObjectName toOld
@@ -150,7 +151,8 @@ resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
textureBinding Texture2D $= Just toName
glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize'
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
case fboStatus of
Complete -> return ()
src/GLHelp.hs
+5
View File
@@ -3,6 +3,7 @@ import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Graphics.GL.Core45
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
mglCreateSingle :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint
@@ -10,3 +11,7 @@ mglCreateSingle f = do
alloca $ \nameptr -> do
f 1 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
rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers
--bindRenderbuffer Renderbuffer $= rboBaseBloomName
--renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
glNamedRenderbufferStorage
rboBaseBloomName
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
pingPongBetween ::
(FramebufferObject, TextureObject) ->
(FramebufferObject, TextureObject) ->
(FBO, TextureObject) ->
(FBO, TextureObject) ->
FullShader ->
IO ()
pingPongBetween (fb1, to1) (fb2, to2) fs = do
bindFramebuffer Framebuffer $= fb2
--bindFramebuffer Framebuffer $= fb2
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2)
textureBinding Texture2D $= Just to1
drawShader fs 4
bindFramebuffer Framebuffer $= fb1
--bindFramebuffer Framebuffer $= fb1
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1)
textureBinding Texture2D $= Just to2
drawShader fs 4
@@ -179,5 +181,6 @@ renderLayer layer shads counts = do
bindTO :: TextureObject -> IO ()
bindTO t = textureBinding Texture2D $= Just t
bindFBO :: FramebufferObject -> IO ()
bindFBO fb = bindFramebuffer Framebuffer $= fb
bindFBO :: FBO -> IO ()
bindFBO fb = --bindFramebuffer Framebuffer $= fb
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb)