get actual triangle on screen

.gitignore

@@ -0,0 +1,2 @@
+dist-newstyle/
+.*.swp

renderer.cabal

@@ -21,6 +21,10 @@ executable renderer
   -- other-extensions:
   build-depends:       base >= 4.13.0.0 && < 5
                      , OpenGL
+                     , OpenGLRaw
                      , sdl2 >= 2.5.0.0
+                     , bytestring
+                     , monad-loops
+                     , random
   hs-source-dirs:      src
   default-language:    Haskell2010

shell.nix

@@ -4,14 +4,18 @@ let
 
   inherit (nixpkgs) pkgs;
 
-  f = { mkDerivation, base, OpenGL, sdl2, stdenv }:
+  f = { mkDerivation, base, bytestring, monad-loops, OpenGL
+      , OpenGLRaw, random, sdl2, stdenv
+      }:
       mkDerivation {
         pname = "renderer";
         version = "0.0.0.0";
         src = ./.;
         isLibrary = false;
         isExecutable = true;
-        executableHaskellDepends = [ base OpenGL sdl2 ];
+        executableHaskellDepends = [
+          base bytestring monad-loops OpenGL OpenGLRaw random sdl2
+        ];
         license = stdenv.lib.licenses.gpl3;
       };
 

src/Main.hs

@@ -1,4 +1,241 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Strict #-}
 module Main where
 
+import SDL (($=), get)
+import qualified SDL
+import qualified SDL.Raw.Video as SDL (glSetAttribute)
+import qualified SDL.Raw.Enum as SDL
+
+import qualified Graphics.Rendering.OpenGL as GL
+import qualified Graphics.GL as GLRaw
+
+import Control.Concurrent.MVar
+
+import Control.Monad
+import Control.Monad.Loops
+
+import Foreign hiding (void)
+import Foreign.Ptr
+import Foreign.Marshal.Array
+import Foreign.Storable
+
+import Data.Word
+
+import qualified Data.ByteString as B
+
+import System.Random (randomRIO)
+
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+
+  -- -- INITIALIZATION
+
+  -- Initialize all the things! (including wacky stuff like joysticks and so on)
+  SDL.initializeAll
+
+  -- create an actual window with OpenGL 3.3
+  window <- SDL.createWindow "renderer" (SDL.defaultWindow
+    { SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
+      { SDL.glProfile = SDL.Core SDL.Normal 3 3
+      }
+    }
+    )
+
+  -- enable context sharing (this is not absolutely neccessary)
+  void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
+
+  -- create ancutal context
+  context <- SDL.glCreateContext window
+
+  -- window should be a window, not fullscreen or so
+  SDL.setWindowMode window SDL.Windowed
+
+  -- show the window
+  SDL.showWindow window
+
+  -- print OpenGL version of active context
+  version <- peekArray0 (0 :: Word8) =<< GLRaw.glGetString GLRaw.GL_VERSION
+  print (B.pack version)
+
+  -- -- VERTICES
+
+  -- first, create and bind a vertex array object
+  bo <- GL.genObjectName
+  GL.bindVertexArrayObject $= Just bo
+
+  -- create and bind buffer for a triangle
+  buf <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just buf
+
+  -- define vertices (positions of the triangle corners) as List of Floats
+  let vertexPositions =
+        [ (-0.5), (-0.5)
+        , 0     , 0.5
+        , 0.5   , (-0.5)
+        ] :: [Float]
+
+  -- put vertices into the buffer
+    -- turn the list into a pointer
+  withArray vertexPositions $ \ptr ->
+    -- Feed the data to the buffer
+    GL.bufferData GL.ArrayBuffer $=
+      -- how much bytes of memory we are going to write (as an Int32)
+      ( fromIntegral $ length vertexPositions * sizeOf (undefined :: Float)
+      -- The pointer to the data
+      , ptr
+      -- The data's usage
+      , GL.StaticDraw
+      )
+
+  -- enable and specify data layout of the in-memory vertices
+  GL.vertexAttribPointer (GL.AttribLocation 0) $=
+    ( GL.ToFloat
+    , GL.VertexArrayDescriptor
+      -- There are 2 components (Floats) to our attribute
+      2
+      -- They are Floats
+      GL.Float
+      -- ???
+      0
+      -- our attribute is directly at the beginning of each vertex
+      (plusPtr nullPtr 0)
+    )
+  GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
+
+  -- -- SHADERS
+
+  -- define shader source code (usually these are separate files)
+  let vertexShader = mconcat
+        [ "#version 330 core\n"
+        , "\n"
+        , "layout(location = 0) in vec4 position;\n"
+        , "\n"
+        , "void main()\n"
+        , "{\n"
+        , "  gl_Position = position;\n"
+        , "}\n"
+        ] :: B.ByteString
+      fragmentShader = mconcat
+        [ "#version 330 core\n"
+        , "\n"
+        , "out vec4 color;\n"
+        , "\n"
+        , "void main()\n"
+        , "{\n"
+        , "  color = vec4(0.0, 1.0, 0.0, 0.5);\n"
+        , "}\n"
+        ] :: B.ByteString
+
+  sp <- createShaderProgram vertexShader fragmentShader
+  GL.currentProgram $= Just sp
+
+  -- -- EVENTING AND DRAWING
+
+  -- initial poll for events
+  evs <- newMVar =<< SDL.pollEvents
+
+  -- Loop running until window closes
+  whileM_ (notElem (SDL.WindowClosedEvent (SDL.WindowClosedEventData window))
+    <$> map SDL.eventPayload <$> readMVar evs) $ do
+      -- poll again
+      void $ swapMVar evs =<< SDL.pollEvents
+
+      -- -- OBEY THE HYPNOTOAD!
+      -- clearcol <- GL.Color4
+      --   <$> (randomRIO (0, 1))
+      --   <*> (randomRIO (0, 1))
+      --   <*> (randomRIO (0, 1))
+      --   <*> pure 1
+      -- GL.clearColor $= clearcol
+
+      -- clear buffers before drawing
+      GL.clear [GL.ColorBuffer]
+      
+      -- tha actual drawing happens here
+      GL.drawArrays GL.Triangles 0 3
+
+      -- make GL finish things up
+      -- GL.flush
+      -- draw context on screen
+      SDL.glSwapWindow window
+
+  -- -- CLEAN UP
+
+  -- wrapping things up
+  putStrLn "loop exited. shutting down."
+
+  -- delete context
+  SDL.glDeleteContext context
+  -- destroy window
+  SDL.destroyWindow window
+  -- quit SDL
+  SDL.quit
+
+  -- This is the end.
+  putStrLn "Bye!"
+
+
+----------------------- Supplemantary functions -------------------------------
+
+-- | create the actual Shader programs from source
+createShaderProgram
+  :: B.ByteString -- ^ vertex shader source
+  -> B.ByteString -- ^ fragment shader source
+  -> IO GL.Program
+createShaderProgram vertSrc fragSrc = do
+  -- create program Object
+  program <- GL.createProgram
+
+  -- create shaders from the source codes given
+  vs <- compileShaderSource GL.VertexShader vertSrc
+  fs <- compileShaderSource GL.FragmentShader fragSrc
+
+  -- attach, link and validate the shader program
+  GL.attachedShaders program $= [vs, fs]
+  GL.linkProgram program
+  GL.validateProgram program 
+
+  ok <- get (GL.validateStatus program)
+  if ok
+  then
+    putStrLn "Shaderprogram linked successfully!"
+  else do
+    info <- get (GL.programInfoLog program)
+    putStrLn "Shaderprogram linking failed!\nInfo log says:"
+    putStrLn info
+    GL.deleteObjectName program
+
+  -- throw away the shaders, since they are linked into the shader program
+  mapM_ (\s -> GL.deleteObjectName s) [fs, vs]
+
+  return program
+
+-- | compile a shader from source
+compileShaderSource
+  :: GL.ShaderType -- ^ what type of shader we are compiling
+  -> B.ByteString    -- ^ its source code
+  -> IO GL.Shader
+compileShaderSource type_ source = do
+  -- create shader object of specified type
+  shaderObject <- GL.createShader type_
+
+  -- assign source code to shader object
+  GL.shaderSourceBS shaderObject $= source
+
+  -- actually compile the shader
+  GL.compileShader shaderObject
+
+  -- error handling
+  ok <- GL.compileStatus shaderObject
+
+  if ok
+  then
+    putStrLn (show type_ ++ ": compilation successfull!")
+  else do
+    info <- get (GL.shaderInfoLog shaderObject)
+    putStrLn (show type_ ++ ": compilation failed!\nInfo log says:")
+    putStrLn info
+    GL.deleteObjectName shaderObject
+
+  return shaderObject