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
121
122
123
124
125
126
127
128
|
{-# LANGUAGE QuasiQuotes, LambdaCase #-}
module Triangle where
import Data.GI.Base.ManagedPtr (newManagedPtr)
import Graphics.Rendering.OpenGL as GL
import GI.Gtk as Gtk
import GI.Gdk.Objects
import Control.Concurrent
import Control.Monad
import Data.ByteString (ByteString)
import Foreign.Marshal (newArray)
import Foreign.Ptr
import Foreign.Storable
import UtilGL
fragment_source :: ByteString
fragment_source = [glslFragment|
#version 330
in vec4 inputColor;
out vec4 outputColor;
void main() {
outputColor = vec4(1.0f, 0.0f, 0.0f, 0.0f); //constant red. I know it's a poor shader
}
|]
vertex_source :: ByteString
vertex_source = [glslVertex|
#version 330
in vec4 position;
void main() { gl_Position = position; }
|]
data State = State
{ stProgram :: Maybe Program
, stBuffer :: Maybe BufferObject
}
initState :: IO (MVar State)
initState = newMVar State
{ stProgram = Nothing
, stBuffer = Nothing
}
drawTriangle :: MVar State -> IO ()
drawTriangle svar = withMVar svar $ \st -> do
forM_ ((,) <$> stProgram st <*> stBuffer st) $ \(program,position_buffer) -> do
-- Use our shaders
GL.currentProgram $= Just program
-- Use the vertices in our buffer
GL.bindBuffer ArrayBuffer $= Just position_buffer
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
GL.vertexAttribPointer (GL.AttribLocation 0) $= (GL.ToFloat,VertexArrayDescriptor 4 GL.Float 0 nullPtr)
-- Draw the three vertices as a triangle
GL.drawArrays Triangles 0 3
-- We finished using the buffers and program
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Disabled
GL.bindBuffer ArrayBuffer $= Nothing
render :: MVar State -> GLArea -> GLContext -> IO Bool
render svar w gl = do
putStrLn "render!"
me <- gLAreaGetError w
maybe id (\e _ -> print e) me $ do
-- Clear the viewport
GL.clearColor $= GL.Color4 0 0 0 1
GL.clear [ColorBuffer]
-- draw our object
drawTriangle svar
GL.flush
return True
realize :: MVar State -> GLArea -> IO ()
realize svar w = do
putStrLn "realize!"
gLAreaMakeCurrent w
me <- gLAreaGetError w
maybe id (\e _ -> print e) me $ do
ctx <- gLAreaGetContext w
-- We only use one VAO, so we always keep it bound
vao <- GL.genObjectName
GL.bindVertexArrayObject $= Just vao
(vertex_data_sz,vertex_data) <- do
ptr <- newArray [ GL.Vertex4 0 0.5 0 1
, GL.Vertex4 0.5 (-0.366) 0 1
, GL.Vertex4 (-0.5) (-0.366) 0 1
]
return ( fromIntegral $ 3 * sizeOf (GL.Vertex4 0 0 0 (0 :: Float) )
, ptr :: Ptr (GL.Vertex4 Float) )
-- This is the buffer that holds the vertices
buffer <- GL.genObjectName
GL.bindBuffer ArrayBuffer $= Just buffer
GL.bufferData ArrayBuffer $= (vertex_data_sz, vertex_data, StaticDraw)
GL.bindBuffer ArrayBuffer $= Nothing
mfrag <- makeShader FragmentShader fragment_source
mvert <- makeShader VertexShader vertex_source
mprog <- makeProgram mfrag mvert
modifyMVar_ svar $ \_ -> return State
{ stProgram = mprog
, stBuffer = Just buffer
}
return ()
unrealize :: MVar State -> GLArea -> IO ()
unrealize _ _ = do
putStrLn "unrealize!"
createContext :: MVar State -> GLArea -> IO GLContext
createContext st glarea = do
st <- readMVar st
widgetGetWindow glarea >>= \case
Just win -> windowCreateGlContext win
Nothing -> do
putStrLn "createContext: GLArea has no window."
mptr <- newManagedPtr nullPtr (return ())
return $ GLContext mptr
|
