aboutsummaryrefslogtreecommitdiff
path: root/Graphics
diff options
context:
space:
mode:
Diffstat (limited to 'Graphics')
-rw-r--r--Graphics/Glyph/ExtendedGL.hs74
-rw-r--r--Graphics/Glyph/ExtendedGL/Base.hs117
-rw-r--r--Graphics/Glyph/ExtendedGL/Framebuffers.hs109
3 files changed, 232 insertions, 68 deletions
diff --git a/Graphics/Glyph/ExtendedGL.hs b/Graphics/Glyph/ExtendedGL.hs
index 86258e1..a056c5b 100644
--- a/Graphics/Glyph/ExtendedGL.hs
+++ b/Graphics/Glyph/ExtendedGL.hs
@@ -1,70 +1,8 @@
-module Graphics.Glyph.ExtendedGL where
+module Graphics.Glyph.ExtendedGL
+ (
+ module All
+ ) where
-import Graphics.Rendering.OpenGL hiding (Points,Lines,Triangles)
-import qualified Graphics.Rendering.OpenGL as GL
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.ARB
+import Graphics.Glyph.ExtendedGL.Framebuffers as All hiding (framebufferBasicParameteri)
+import Graphics.Glyph.ExtendedGL.Base as All
-import Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Foreign.Storable
-import Foreign.C.Types
-
-import System.IO.Unsafe
-import Control.Monad
-
-data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show,Enum)
-
-class IsPrimitiveModeMarshallable a where
- marshalPrimitiveMode :: a -> GLuint
-
-instance IsPrimitiveModeMarshallable ExPrimitiveMode where
- marshalPrimitiveMode x = case x of
- Points -> gl_POINTS
- Triangles -> gl_TRIANGLES
- Lines -> gl_LINES
- Patches -> gl_PATCHES
-
-instance IsPrimitiveModeMarshallable 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
-
-drawArraysInstanced ::
- (IsPrimitiveModeMarshallable a) => a -> ArrayIndex -> NumArrayIndices -> GLsizei -> IO ()
-drawArraysInstanced = glDrawArraysInstanced . marshalPrimitiveMode
-
-vertexAttributeDivisor :: AttribLocation -> SettableStateVar GLuint
-vertexAttributeDivisor (AttribLocation loc) =
- makeSettableStateVar $ \val ->
- glVertexAttribDivisor loc val
-
-patchVertices :: (Integral a) => SettableStateVar a
-patchVertices =
- makeSettableStateVar $ \val ->
- glPatchParameteri gl_PATCH_VERTICES $ fromIntegral val
-
-maxPatchVertices :: IO CInt
-maxPatchVertices =
- alloca $ \ptr -> do
- glGetIntegerv gl_MAX_PATCH_VERTICES ptr
- peek ptr
-
-getGLVersion :: IO String
-getGLVersion =
- 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)
- return ("OpenGL " ++ show v1 ++ "." ++ show v2)
diff --git a/Graphics/Glyph/ExtendedGL/Base.hs b/Graphics/Glyph/ExtendedGL/Base.hs
new file mode 100644
index 0000000..48f61a5
--- /dev/null
+++ b/Graphics/Glyph/ExtendedGL/Base.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Graphics.Glyph.ExtendedGL.Base where
+
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Graphics.Rendering.OpenGL.Raw.ARB
+
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+
+import System.IO.Unsafe
+import Control.Monad
+
+import Data.StateVar
+import Unsafe.Coerce
+
+data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show,Enum)
+
+class IsBindable a where
+ bind :: a -> IO ()
+class IsGLEnumMarshallable a where
+ toGLEnum :: a -> GLenum
+class IsGenerable a where
+ generate :: IO a
+class IsWrappedPrimitive t a where
+ unwrap :: a -> t
+ wrap :: t -> a
+class HasIntegerParam t a where
+ parami :: t -> a -> SettableStateVar GLuint
+class HasFloatParam t a where
+ paramf :: t -> a -> SettableStateVar GLfloat
+class HasParamOfType b t a where
+ param :: t -> a -> SettableStateVar b
+
+class IsPrimitiveModeMarshallable a where
+ marshalPrimitiveMode :: a -> GLuint
+
+castPrimitive :: forall a b t. (IsWrappedPrimitive t a, IsWrappedPrimitive t b) => a -> b
+castPrimitive x = wrap unw
+ where
+ unw :: t
+ unw = unwrap x
+
+instance (IsWrappedPrimitive a a) where
+ unwrap = id
+ wrap = id
+instance (IsWrappedPrimitive GLenum a) => IsGLEnumMarshallable a where
+ toGLEnum = unwrap
+
+instance IsPrimitiveModeMarshallable ExPrimitiveMode where
+ 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
+
+instance IsPrimitiveModeMarshallable GLuint where
+ marshalPrimitiveMode = id
+
+drawArraysInstanced ::
+ (IsPrimitiveModeMarshallable a) =>
+ a -> GL.ArrayIndex ->
+ GL.NumArrayIndices ->
+ GLsizei -> IO ()
+drawArraysInstanced = glDrawArraysInstanced . marshalPrimitiveMode
+
+vertexAttributeDivisor :: GL.AttribLocation -> SettableStateVar GLuint
+vertexAttributeDivisor (GL.AttribLocation loc) =
+ 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
+
+{- Returns the maximum number of patches
+ - for a tessilation shader -}
+maxPatchVertices :: IO CInt
+maxPatchVertices =
+ alloca $ \ptr -> do
+ glGetIntegerv gl_MAX_PATCH_VERTICES ptr
+ peek ptr
+
+getGLVersion :: IO String
+getGLVersion =
+ 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)
+ return ("OpenGL " ++ show v1 ++ "." ++ show v2)
+
+coerced :: a
+coerced = unsafeCoerce (0::Int)
diff --git a/Graphics/Glyph/ExtendedGL/Framebuffers.hs b/Graphics/Glyph/ExtendedGL/Framebuffers.hs
new file mode 100644
index 0000000..abe9756
--- /dev/null
+++ b/Graphics/Glyph/ExtendedGL/Framebuffers.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Graphics.Glyph.ExtendedGL.Framebuffers where
+
+import Graphics.Rendering.OpenGL.Raw.ARB
+import Graphics.Rendering.OpenGL.Raw.Core31
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.Glyph.ExtendedGL.Base
+
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+
+import Data.StateVar
+import Control.Monad
+
+import Unsafe.Coerce
+
+
+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
+
+framebufferBasicParameteri :: (IsFramebuffer a) => GLenum -> a -> GLenum -> SettableStateVar GLuint
+framebufferBasicParameteri typ fb enum =
+ makeSettableStateVar (\value -> do
+ bind fb
+ glFramebufferParameteri typ enum $ fromIntegral value)
+
+data Renderbuffer = Renderbuffer GLuint
+instance IsWrappedPrimitive GLuint Renderbuffer where
+ unwrap (Renderbuffer x) = x
+instance IsGenerable Renderbuffer where
+ generate = alloca $ \ptr -> do
+ glGenRenderbuffers 1 ptr
+ liftM Renderbuffer $ peek ptr
+instance IsBindable Renderbuffer where
+ bind = glBindRenderbuffer gl_RENDERBUFFER . unwrap
+
+data RenderbufferArgument =
+ DepthAttachment
+instance IsWrappedPrimitive GLenum RenderbufferArgument where
+ 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
+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
+
+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
+
+instance HasIntegerParam GLenum DrawFramebuffer where
+ 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
+
+instance IsGenerable DrawFramebuffer where
+ generate = alloca $ \ptr -> do
+ glGenFramebuffers 1 ptr
+ liftM DrawFramebuffer $ peek ptr
+
+instance IsBindable DrawFramebuffer where
+ bind (DrawFramebuffer fb) = glBindFramebuffer gl_DRAW_FRAMEBUFFER fb
+
+instance IsWrappedPrimitive GLuint DrawFramebuffer where
+ unwrap (DrawFramebuffer fb) = fb
+ wrap = DrawFramebuffer
+
+instance IsFramebuffer DrawFramebuffer where
+ getType _ = gl_DRAW_FRAMEBUFFER
generated by cgit (git 2.34.1) at 2025-07-23 19:21:01 +0000