diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0f22fc9 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +dist-newstyle/ +.*.swp diff --git a/renderer.cabal b/renderer.cabal index fcbf062..210e175 100644 --- a/renderer.cabal +++ b/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 diff --git a/shell.nix b/shell.nix index 9fea4e9..eaf10d1 100644 --- a/shell.nix +++ b/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; }; diff --git a/src/Main.hs b/src/Main.hs index 65ae4a0..960fc50 100644 --- a/src/Main.hs +++ b/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