aboutsummaryrefslogtreecommitdiff
path: root/Graphics/Glyph/ExtendedGL/Framebuffers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Graphics/Glyph/ExtendedGL/Framebuffers.hs')
-rw-r--r--Graphics/Glyph/ExtendedGL/Framebuffers.hs137
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