From 31b12994b0f5273282271ff3ed04596f49bc8003 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sun, 7 Apr 2019 10:03:04 -0400 Subject: Example using GLArea without gtk-declarative. --- Triangle.hs | 117 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 117 insertions(+) create mode 100644 Triangle.hs (limited to 'Triangle.hs') 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!" -- cgit v1.2.3