aboutsummaryrefslogtreecommitdiff
path: root/Graphics/Glyph/ExtendedGL
diff options
context:
space:
mode:
Diffstat (limited to 'Graphics/Glyph/ExtendedGL')
-rw-r--r--Graphics/Glyph/ExtendedGL/Base.hs124
-rw-r--r--Graphics/Glyph/ExtendedGL/Framebuffers.hs137
2 files changed, 139 insertions, 122 deletions
diff --git a/Graphics/Glyph/ExtendedGL/Base.hs b/Graphics/Glyph/ExtendedGL/Base.hs
index 88566f4..9b50ddb 100644
--- a/Graphics/Glyph/ExtendedGL/Base.hs
+++ b/Graphics/Glyph/ExtendedGL/Base.hs
@@ -1,111 +1,117 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-module Graphics.Glyph.ExtendedGL.Base where
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
-import qualified Graphics.Rendering.OpenGL as GL
-import Graphics.GL.Core43
-import Graphics.GL.Compatibility30
+module Graphics.Glyph.ExtendedGL.Base where
+import Control.Monad
+import Data.Proxy
+import Data.StateVar
+import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
-import Foreign.C.Types
-
+import Graphics.GL.Compatibility30
+import Graphics.GL.Core43
+import qualified Graphics.Rendering.OpenGL as GL
import System.IO.Unsafe
-import Control.Monad
-
-import Data.StateVar
import Unsafe.Coerce
-import Data.Proxy
-data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show,Enum)
+data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show, Enum)
class IsBindable a where
- bind :: a -> IO ()
+ bind :: a -> IO ()
+
class IsGLEnumMarshallable a where
- toGLEnum :: a -> GLenum
+ toGLEnum :: a -> GLenum
+
class IsGenerable a where
- generate :: IO a
+ generate :: IO a
+
class IsWrappedPrimitive t a where
- unwrap :: a -> t
- wrap :: t -> a
+ unwrap :: a -> t
+ wrap :: t -> a
+
class HasIntegerParam t a where
- parami :: t -> a -> SettableStateVar GLuint
+ parami :: t -> a -> SettableStateVar GLuint
+
class HasFloatParam t a where
- paramf :: t -> a -> SettableStateVar GLfloat
+ paramf :: t -> a -> SettableStateVar GLfloat
+
class HasParamOfType b t a where
- param :: t -> a -> SettableStateVar b
+ param :: t -> a -> SettableStateVar b
class IsPrimitiveModeMarshallable a where
- marshalPrimitiveMode :: a -> GLuint
+ marshalPrimitiveMode :: a -> GLuint
castPrimitive :: forall a b t. (IsWrappedPrimitive t a, IsWrappedPrimitive t b) => Proxy t -> a -> b
castPrimitive _ x = wrap unw
- where
- unw :: t
- unw = unwrap x
+ where
+ unw :: t
+ unw = unwrap x
instance (IsWrappedPrimitive a a) where
- unwrap = id
- wrap = id
+ unwrap = id
+ wrap = id
+
instance (IsWrappedPrimitive GLenum a) => IsGLEnumMarshallable a where
- toGLEnum = unwrap
+ toGLEnum = unwrap
instance IsPrimitiveModeMarshallable ExPrimitiveMode where
- marshalPrimitiveMode x = case x of
- Points -> GL_POINTS
- Triangles -> GL_TRIANGLES
- Lines -> GL_LINES
- Patches -> GL_PATCHES
+ marshalPrimitiveMode x = case x of
+ Points -> GL_POINTS
+ Triangles -> GL_TRIANGLES
+ Lines -> GL_LINES
+ Patches -> GL_PATCHES
instance IsPrimitiveModeMarshallable GL.PrimitiveMode where
- marshalPrimitiveMode x = case x of
- GL.Points -> 0x0
- GL.Lines -> 0x1
- GL.LineLoop -> 0x2
- GL.LineStrip -> 0x3
- GL.Triangles -> 0x4
- GL.TriangleStrip -> 0x5
- GL.TriangleFan -> 0x6
- GL.Quads -> 0x7
- GL.QuadStrip -> 0x8
- GL.Polygon -> 0x9
+ marshalPrimitiveMode x = case x of
+ GL.Points -> 0x0
+ GL.Lines -> 0x1
+ GL.LineLoop -> 0x2
+ GL.LineStrip -> 0x3
+ GL.Triangles -> 0x4
+ GL.TriangleStrip -> 0x5
+ GL.TriangleFan -> 0x6
+ GL.Quads -> 0x7
+ GL.QuadStrip -> 0x8
+ GL.Polygon -> 0x9
instance IsPrimitiveModeMarshallable GLuint where
- marshalPrimitiveMode = id
+ marshalPrimitiveMode = id
vertexAttributeDivisor :: GL.AttribLocation -> SettableStateVar GLuint
vertexAttributeDivisor (GL.AttribLocation loc) =
- makeSettableStateVar $ \val ->
- glVertexAttribDivisor loc val
+ makeSettableStateVar $ \val ->
+ glVertexAttribDivisor loc val
{- Sets the number of vertices per patch
- for OpenGL -}
patchVertices :: (Integral a) => SettableStateVar a
-patchVertices =
- makeSettableStateVar $ \val ->
- glPatchParameteri GL_PATCH_VERTICES $ fromIntegral val
+patchVertices =
+ makeSettableStateVar $ \val ->
+ glPatchParameteri GL_PATCH_VERTICES $ fromIntegral val
{- Returns the maximum number of patches
- for a tessilation shader -}
maxPatchVertices :: IO CInt
maxPatchVertices =
- alloca $ \ptr -> do
- glGetIntegerv GL_MAX_PATCH_VERTICES ptr
- fromIntegral <$> peek ptr
+ alloca $ \ptr -> do
+ glGetIntegerv GL_MAX_PATCH_VERTICES ptr
+ fromIntegral <$> peek ptr
getGLVersion :: IO String
getGLVersion =
- let lift2 (a,b) = do
- x <- a ; y <- b ; return (x,y)
- in
- alloca $ \ptr1 -> alloca $ \ptr2 -> do
+ let lift2 (a, b) = do
+ x <- a
+ y <- b
+ return (x, y)
+ in alloca $ \ptr1 -> alloca $ \ptr2 -> do
glGetIntegerv GL_MAJOR_VERSION ptr1
glGetIntegerv GL_MINOR_VERSION ptr2
- (v1,v2) <- lift2 (peek ptr1, peek ptr2)
+ (v1, v2) <- lift2 (peek ptr1, peek ptr2)
return ("OpenGL " ++ show v1 ++ "." ++ show v2)
coerced :: a
-coerced = unsafeCoerce (0::Int)
+coerced = unsafeCoerce (0 :: Int)
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