Example using GLArea without gtk-declarative.

1 files changed, 117 insertions, 0 deletions

diff --git a/Triangle.hs b/Triangle.hs
new file mode 100644
index 0000000..cf26fe6
--- /dev/null
+++ b/Triangle.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Triangle where
+
+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 :: GLArea -> IO ()
+unrealize _ = do
+    putStrLn "unrealize!"