Files
loop/src/Framebuffer/Setup.hs
T
2023-03-09 17:55:19 +00:00

87 lines
3.4 KiB
Haskell

-- | For initialising framebuffers.
module Framebuffer.Setup (
setupTextureFramebuffer,
setupFramebufferGivenStencil,
setupFramebuffer2GivenStencil,
setupShadowFramebuffer,
) where
import Unsafe.Coerce
import Data.Preload.Render
import GLHelp
import Graphics.GL.Core45
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
setupTextureFramebuffer ::
GLsizei ->
GLsizei ->
IO (FBO, TO)
{-# INLINE setupTextureFramebuffer #-}
setupTextureFramebuffer x y = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
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 to 0
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
return (FBO fboName, TO to)
setupShadowFramebuffer :: IO (FBO, (TO, TO))
setupShadowFramebuffer = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
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, (TO to1,TO to2))
setupFramebufferGivenStencil ::
GLuint -> -- RenderbufferObject
IO (FBO, TO)
{-# INLINE setupFramebufferGivenStencil #-}
setupFramebufferGivenStencil rboName = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
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, TO to1)
setupFramebuffer2GivenStencil ::
GLuint -> -- RenderbufferObject
IO (FBO, (TO, TO))
setupFramebuffer2GivenStencil rboName = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
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, (TO to1, TO to2))