renderer-tutorial/src/Main.hs

212 lines
5 KiB
Haskell

{-# 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)
-- internal imports
import BindableClass
import BufferClass
import VertexArray
import VertexBuffer
import IndexBuffer
import Shader
import Renderer
import Texture
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
[ (-0.5), (-0.5), 0, 0, 0 -- 0
, 0.5 , (-0.5), 0, 1, 0 -- 1
, 0.5 , 0.5 , 0, 1, 1 -- 2
, (-0.5), 0.5 , 0, 0, 1 -- 3
] :: [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
-- -- 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"
]
-- -- tell the shader where to find the texture
bind sp
setUniform sp "u_texture" (texSlot tex)
-- -- 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
incrementValue <- takeMVar increment
redValue <- takeMVar red
let newRed = redValue + incrementValue
-- write data to the uniform
bind sp
setUniform sp "u_color" (GL.Color4 newRed 0.5 0 1 :: GL.Color4 GL.GLfloat)
-- the actual drawing happens here
draw vao ibo sp
err <- get GL.errors
when (not $ null err) (print $ "loop errors: " <> show err)
-- update MVAr values
putMVar red newRed
-- cycle the increment for red if neccessary
if (newRed + incrementValue > 1 || newRed + incrementValue < 0)
then
putMVar increment (-incrementValue)
else
putMVar increment incrementValue
-- 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!"