62 lines
2.2 KiB
Haskell
62 lines
2.2 KiB
Haskell
{- | For initialising framebuffers.
|
|
-}
|
|
module Framebuffer.Setup
|
|
( setupTextureFramebuffer
|
|
, setupFramebufferGivenStencil
|
|
, setupFramebuffer2GivenStencil
|
|
) where
|
|
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
|
import Graphics.GL.Core43
|
|
|
|
setupTextureFramebuffer
|
|
:: GLsizei
|
|
-> GLsizei
|
|
-> IO (FramebufferObject, TextureObject)
|
|
{-# INLINE setupTextureFramebuffer #-}
|
|
setupTextureFramebuffer x y = do
|
|
fboName <- genObjectName
|
|
bindFramebuffer Framebuffer $= fboName
|
|
|
|
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
|
|
fboStatus <- framebufferStatus Framebuffer
|
|
case fboStatus of
|
|
Complete -> return ()
|
|
_ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
|
|
return (fboName, fboTO)
|
|
|
|
setupFramebufferGivenStencil
|
|
:: RenderbufferObject
|
|
-> IO (FramebufferObject, TextureObject)
|
|
{-# INLINE setupFramebufferGivenStencil #-}
|
|
setupFramebufferGivenStencil rboName = do
|
|
fboName <- genObjectName
|
|
bindFramebuffer Framebuffer $= fboName
|
|
toName <- genObjectName
|
|
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
|
|
fboStatus <- framebufferStatus Framebuffer
|
|
case fboStatus of
|
|
Complete -> return ()
|
|
_ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
|
|
return (fboName,toName)
|
|
setupFramebuffer2GivenStencil
|
|
:: RenderbufferObject
|
|
-> IO (FramebufferObject, (TextureObject,TextureObject))
|
|
setupFramebuffer2GivenStencil rboName = do
|
|
fboName <- genObjectName
|
|
bindFramebuffer Framebuffer $= fboName
|
|
toName <- genObjectName
|
|
toName2 <- genObjectName
|
|
framebufferRenderbuffer Framebuffer DepthStencilAttachment 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))
|
|
|
|
minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
|
|
minMagFilter = ((Nearest,Nothing),Nearest)
|