diff options
Diffstat (limited to 'Graphics/Glyph/ExtendedGL/Framebuffers.hs')
-rw-r--r-- | Graphics/Glyph/ExtendedGL/Framebuffers.hs | 137 |
1 files changed, 74 insertions, 63 deletions
diff --git a/Graphics/Glyph/ExtendedGL/Framebuffers.hs b/Graphics/Glyph/ExtendedGL/Framebuffers.hs index a6c2891..1de7781 100644 --- a/Graphics/Glyph/ExtendedGL/Framebuffers.hs +++ b/Graphics/Glyph/ExtendedGL/Framebuffers.hs @@ -1,109 +1,120 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} module Graphics.Glyph.ExtendedGL.Framebuffers where -import Graphics.GL.Compatibility30 -import Graphics.GL.Core43 -import qualified Graphics.Rendering.OpenGL as GL - -import Graphics.Glyph.ExtendedGL.Base - +import Control.Monad +import Data.StateVar +import Foreign.C.Types import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable -import Foreign.C.Types - -import Data.StateVar -import Control.Monad - +import Graphics.GL.Compatibility30 +import Graphics.GL.Core43 +import Graphics.Glyph.ExtendedGL.Base +import qualified Graphics.Rendering.OpenGL as GL import Unsafe.Coerce - -class ( - HasParamOfType GLuint FramebufferParameter a, +class + ( HasParamOfType GLuint FramebufferParameter a, HasIntegerParam GLenum a, IsGenerable a, - IsBindable a, IsWrappedPrimitive GLuint a) => IsFramebuffer a where - - -- this function MUST discard the argument - getType :: a -> GLenum + IsBindable a, + IsWrappedPrimitive GLuint a + ) => + IsFramebuffer a + where + -- this function MUST discard the argument + getType :: a -> GLenum framebufferBasicParameteri :: (IsFramebuffer a) => GLenum -> a -> GLenum -> SettableStateVar GLuint framebufferBasicParameteri typ fb enum = - makeSettableStateVar (\value -> do + makeSettableStateVar + ( \value -> do bind fb - glFramebufferParameteri typ enum $ fromIntegral value) + glFramebufferParameteri typ enum $ fromIntegral value + ) data Renderbuffer = Renderbuffer GLuint + instance IsWrappedPrimitive GLuint Renderbuffer where - unwrap (Renderbuffer x) = x + unwrap (Renderbuffer x) = x + instance IsGenerable Renderbuffer where - generate = alloca $ \ptr -> do - glGenRenderbuffers 1 ptr - liftM Renderbuffer $ peek ptr + generate = alloca $ \ptr -> do + glGenRenderbuffers 1 ptr + liftM Renderbuffer $ peek ptr + instance IsBindable Renderbuffer where - bind = glBindRenderbuffer GL_RENDERBUFFER . unwrap + bind = glBindRenderbuffer GL_RENDERBUFFER . unwrap + +data RenderbufferArgument + = DepthAttachment -data RenderbufferArgument = - DepthAttachment instance IsWrappedPrimitive GLenum RenderbufferArgument where - unwrap DepthAttachment = GL_DEPTH_ATTACHMENT + unwrap DepthAttachment = GL_DEPTH_ATTACHMENT renderBufferStorageRaw :: (IsGLEnumMarshallable a, IsGLEnumMarshallable b) => a -> b -> Int -> Int -> IO () -renderBufferStorageRaw typ enum w h = glRenderbufferStorage (toGLEnum typ) - (toGLEnum enum) (fromIntegral w) (fromIntegral h) -renderBufferStorage :: (IsGLEnumMarshallable a) => Renderbuffer -> SettableStateVar (a,Int,Int) -renderBufferStorage buffer = makeSettableStateVar $ \(en,w,h) -> do - bind buffer - renderBufferStorageRaw GL_RENDERBUFFER en w h - -frameBufferRenderBuffer :: forall a b. (IsFramebuffer a,IsGLEnumMarshallable b) => Renderbuffer -> b -> IO a +renderBufferStorageRaw typ enum w h = + glRenderbufferStorage + (toGLEnum typ) + (toGLEnum enum) + (fromIntegral w) + (fromIntegral h) + +renderBufferStorage :: (IsGLEnumMarshallable a) => Renderbuffer -> SettableStateVar (a, Int, Int) +renderBufferStorage buffer = makeSettableStateVar $ \(en, w, h) -> do + bind buffer + renderBufferStorageRaw GL_RENDERBUFFER en w h + +frameBufferRenderBuffer :: forall a b. (IsFramebuffer a, IsGLEnumMarshallable b) => Renderbuffer -> b -> IO a frameBufferRenderBuffer rb e = do - let enum :: GLenum - enum = getType test - unw :: GLuint - unw = unwrap rb - bind rb - glFramebufferRenderbuffer enum (toGLEnum e) GL_RENDERBUFFER (unwrap rb) - return $ wrap unw - where - test :: a - test = coerced + let enum :: GLenum + enum = getType test + unw :: GLuint + unw = unwrap rb + bind rb + glFramebufferRenderbuffer enum (toGLEnum e) GL_RENDERBUFFER (unwrap rb) + return $ wrap unw + where + test :: a + test = coerced data DrawFramebuffer = DrawFramebuffer GLuint + data FramebufferParameter = DefaultWidth | DefaultHeight instance IsWrappedPrimitive GLenum FramebufferParameter where - unwrap p = case p of - DefaultWidth -> GL_FRAMEBUFFER_DEFAULT_WIDTH - DefaultHeight -> GL_FRAMEBUFFER_DEFAULT_HEIGHT - wrap x | x == GL_FRAMEBUFFER_DEFAULT_WIDTH = DefaultWidth - | x == GL_FRAMEBUFFER_DEFAULT_HEIGHT = DefaultHeight - | otherwise = undefined + unwrap p = case p of + DefaultWidth -> GL_FRAMEBUFFER_DEFAULT_WIDTH + DefaultHeight -> GL_FRAMEBUFFER_DEFAULT_HEIGHT + wrap x + | x == GL_FRAMEBUFFER_DEFAULT_WIDTH = DefaultWidth + | x == GL_FRAMEBUFFER_DEFAULT_HEIGHT = DefaultHeight + | otherwise = undefined instance HasIntegerParam GLenum DrawFramebuffer where - parami p fb = framebufferBasicParameteri GL_DRAW_FRAMEBUFFER fb p + parami p fb = framebufferBasicParameteri GL_DRAW_FRAMEBUFFER fb p {- Has parameters of type GLuint which are acessable by the data FramebufferParameter for - the type DrawFramebuffer -} instance HasParamOfType GLuint FramebufferParameter DrawFramebuffer where - param = parami . toGLEnum + param = parami . toGLEnum instance IsGenerable DrawFramebuffer where - generate = alloca $ \ptr -> do - glGenFramebuffers 1 ptr - liftM DrawFramebuffer $ peek ptr + generate = alloca $ \ptr -> do + glGenFramebuffers 1 ptr + liftM DrawFramebuffer $ peek ptr instance IsBindable DrawFramebuffer where - bind (DrawFramebuffer fb) = glBindFramebuffer GL_DRAW_FRAMEBUFFER fb + bind (DrawFramebuffer fb) = glBindFramebuffer GL_DRAW_FRAMEBUFFER fb instance IsWrappedPrimitive GLuint DrawFramebuffer where - unwrap (DrawFramebuffer fb) = fb - wrap = DrawFramebuffer + unwrap (DrawFramebuffer fb) = fb + wrap = DrawFramebuffer instance IsFramebuffer DrawFramebuffer where - getType _ = GL_DRAW_FRAMEBUFFER + getType _ = GL_DRAW_FRAMEBUFFER |