blob: abe9756610912c016991ab39f838397534712006 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
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
|
