blob: 1de7781ff4f02cf622c62b229d6ef29bc7fb426b (
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
110
111
112
113
114
115
116
117
118
119
120
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Graphics.Glyph.ExtendedGL.Framebuffers where
import Control.Monad
import Data.StateVar
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
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,
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
|
