{-# 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 qualified Data.ByteString.Char8 as B8 import qualified Data.List as L import System.Random (randomRIO) main :: IO () 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 -- define vertices (positions of the triangle corners) as List of Floats let vertexPositions = [ (-0.5), (-0.5) -- 0 , 0.5 , (-0.5) -- 1 , 0.5 , 0.5 -- 2 , (-0.5), 0.5 -- 3 ] :: [GL.GLfloat] -- create draw order indices indices = [0, 1, 2, 2, 3, 0] :: [GL.GLuint] -- create and bind buffer for vertices buf <- GL.genObjectName GL.bindBuffer GL.ArrayBuffer $= Just buf -- 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 :: GL.GLfloat) -- 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 -- create and bind buffer index buffer ibo <- GL.genObjectName GL.bindBuffer GL.ElementArrayBuffer $= Just ibo -- put indices into index buffer -- turn the list into a pointer withArray indices $ \ptr -> do -- Feed the data to the buffer GL.bufferData GL.ElementArrayBuffer $= -- how much bytes of memory we are going to write (as an Int32) ( fromIntegral $ length indices * sizeOf (undefined :: GL.GLuint) -- The pointer to the data , ptr -- The data's usage , GL.StaticDraw ) -- -- SHADERS -- read in shaders from source file vertSrc <- B.readFile "./res/shaders/vert.shader" fragSrc <- B.readFile "./res/shaders/frag.shader" sp <- createShaderProgram vertSrc fragSrc GL.currentProgram $= Just sp err <- get GL.errors print $ "pre-loop errors: " <> show err -- -- 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] -- the actual drawing happens here void $ get GL.errors GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr err <- get GL.errors when (not $ null err) (print $ "loop errors: " <> show err) -- 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