{-# 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) import Linear -- internal imports import BindableClass import BufferClass import VertexArray import VertexBuffer import IndexBuffer import Shader import Renderer import Texture import EventHandler 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 -- synchronize buffer swapping with monitor's vsync SDL.swapInterval $= SDL.SynchronizedUpdates -- 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 vao <- GL.genObjectName GL.bindVertexArrayObject $= Just vao -- define vertices (positions of the rectangle corners) as List of Floats -- with added in texture coordinates let vertexPositions = -- 3D positions | texture coordinates [ 100, 100, 0, 0, 0 , 233, 100, 0, 1, 0 , 233, 300, 0, 1, 1 , 100, 300, 0, 0, 1 ] :: [GL.GLfloat] -- create draw order indices indices = [0, 1, 2, 2, 3, 0] :: [GL.GLuint] -- construct new VertexBuffer and fill it with data vao <- newVertexArray vbo <- newVertexBuffer vertexPositions -- rebind the vertex buffer bind vbo -- enable and specify data layout of the in-memory vertices layout <- newVertexBufferLayout -- push vertex positions pushElements layout GL.Float 3 -- pusht texture coordinates pushElements layout GL.Float 2 addBuffer vao vbo layout -- -- MATRICES let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 (-100) 0 0) mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0) -- store the mtrices for later adjustments proj <- newMVar mproj view <- newMVar mview model <- newMVar mmodel -- -- TEXTURE -- generate and bind texture tex <- newTexture "res/textures/lynx.jpg" 0 bind tex -- construct new IndexBuffer and fill it with data ibo <- newIndexBuffer indices -- -- SHADERS sp <- newShader [ ShaderSource GL.VertexShader "./res/shaders/vert.shader" , ShaderSource GL.FragmentShader "./res/shaders/frag.shader" ] [ "u_color" , "u_texture" , "u_mvp" ] -- -- tell the shader where to find the texture bind sp setUniform sp "u_texture" (texSlot tex) setUniform sp "u_mvp" (mproj !*! mview !*! mmodel) -- -- UNIFORMS -- create MVars for pulsating red channel red <- newMVar 0 increment <- newMVar 0.05 err <- get GL.errors print $ "pre-loop errors: " <> show err -- -- EVENTING AND DRAWING -- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS unbind vao unbind vbo unbind ibo unbind sp -- -- LOOPING -- 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 -- -- rebind everything neccessary for draw call bind sp -- retrieve matrices from MVars and modify them on demand moveQuad proj view model evs mproj <- readMVar proj mview <- readMVar view mmodel <- readMVar model setUniform sp "u_mvp" (mproj !*! mview !*! mmodel) -- the actual drawing happens here draw vao ibo sp -- 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!"