renderer-tutorial/src/Main.hs

240 lines
5.7 KiB
Haskell
Raw Normal View History

2020-05-17 04:40:30 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
2020-05-15 18:04:18 +00:00
module Main where
2020-05-17 04:40:30 +00:00
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
2020-05-17 08:59:15 +00:00
import qualified Data.ByteString.Char8 as B8
import qualified Data.List as L
2020-05-17 04:40:30 +00:00
import System.Random (randomRIO)
import Linear
2020-05-18 02:58:45 +00:00
-- internal imports
2020-05-21 16:17:38 +00:00
import BindableClass
2020-05-18 02:58:45 +00:00
import BufferClass
2020-05-20 03:54:14 +00:00
import VertexArray
2020-05-18 02:58:45 +00:00
import VertexBuffer
import IndexBuffer
2020-05-21 19:04:05 +00:00
import Shader
2020-05-22 00:29:16 +00:00
import Renderer
2020-05-22 14:16:06 +00:00
import Texture
2020-08-09 20:24:32 +00:00
import EventHandler
2020-05-18 02:58:45 +00:00
2020-05-15 18:04:18 +00:00
main :: IO ()
2020-05-17 04:40:30 +00:00
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
2020-05-17 15:27:18 +00:00
-- synchronize buffer swapping with monitor's vsync
SDL.swapInterval $= SDL.SynchronizedUpdates
2020-05-17 04:40:30 +00:00
-- 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
2020-05-17 19:27:35 +00:00
vao <- GL.genObjectName
GL.bindVertexArrayObject $= Just vao
2020-05-17 04:40:30 +00:00
2020-05-22 14:16:06 +00:00
-- define vertices (positions of the rectangle corners) as List of Floats
-- with added in texture coordinates
2020-05-17 04:40:30 +00:00
let vertexPositions =
2020-08-10 13:09:23 +00:00
-- 3D positions | texture coordinates
[ -67, -100, 0, 0, 0
, 67, -100, 0, 1, 0
, 67, 100, 0, 1, 1
, -67, 100, 0, 0, 1
2020-05-17 11:04:13 +00:00
] :: [GL.GLfloat]
2020-05-17 04:40:30 +00:00
2020-05-17 10:26:57 +00:00
-- create draw order indices
2020-05-17 11:04:13 +00:00
indices = [0, 1, 2, 2, 3, 0] :: [GL.GLuint]
2020-05-17 10:26:57 +00:00
2020-05-18 02:58:45 +00:00
-- construct new VertexBuffer and fill it with data
2020-05-20 03:54:14 +00:00
vao <- newVertexArray
2020-05-18 02:58:45 +00:00
vbo <- newVertexBuffer vertexPositions
-- rebind the vertex buffer
bind vbo
2020-05-20 03:54:14 +00:00
2020-05-17 04:40:30 +00:00
-- enable and specify data layout of the in-memory vertices
2020-05-20 03:54:14 +00:00
layout <- newVertexBufferLayout
2020-05-22 14:16:06 +00:00
-- push vertex positions
pushElements layout GL.Float 3
-- pusht texture coordinates
2020-05-20 03:54:14 +00:00
pushElements layout GL.Float 2
addBuffer vao vbo layout
-- -- MATRICES
let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
2020-08-10 13:09:23 +00:00
mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
mmodel1 = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0)
mmodel2 = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 400 400 0)
-- store the mtrices for later adjustments
proj <- newMVar mproj
view <- newMVar mview
2020-08-10 13:09:23 +00:00
model1 <- newMVar mmodel1
model2 <- newMVar mmodel2
2020-05-22 14:16:06 +00:00
-- -- TEXTURE
-- generate and bind texture
tex <- newTexture "res/textures/lynx.jpg" 0
bind tex
2020-05-17 04:40:30 +00:00
2020-05-18 02:58:45 +00:00
-- construct new IndexBuffer and fill it with data
ibo <- newIndexBuffer indices
2020-05-17 10:26:57 +00:00
2020-05-17 04:40:30 +00:00
-- -- SHADERS
2020-05-21 19:04:05 +00:00
sp <- newShader
[ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
, ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
]
[ "u_color"
2020-05-22 14:16:06 +00:00
, "u_texture"
, "u_mvp"
2020-05-21 19:04:05 +00:00
]
2020-05-17 11:37:59 +00:00
2020-05-22 14:16:06 +00:00
-- -- tell the shader where to find the texture
bind sp
setUniform sp "u_texture" (texSlot tex)
2020-05-17 11:37:59 +00:00
-- -- UNIFORMS
2020-05-17 11:06:09 +00:00
err <- get GL.errors
print $ "pre-loop errors: " <> show err
2020-05-17 04:40:30 +00:00
-- -- EVENTING AND DRAWING
2020-08-10 13:09:23 +00:00
switch <- newMVar model1
2020-05-17 19:27:35 +00:00
-- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS
2020-05-22 14:16:06 +00:00
unbind vao
2020-05-18 02:58:45 +00:00
unbind vbo
unbind ibo
2020-05-21 19:04:05 +00:00
unbind sp
2020-05-17 19:27:35 +00:00
-- -- LOOPING
2020-05-17 04:40:30 +00:00
-- 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
2020-08-10 13:09:23 +00:00
-- clear previous frame
clear
2020-05-22 21:48:40 +00:00
2020-08-10 13:09:23 +00:00
-- retrieve matrices from MVars
2020-08-09 20:24:32 +00:00
mproj <- readMVar proj
mview <- readMVar view
2020-08-10 13:09:23 +00:00
-- modify the mvars based on keystrokes
switchObject switch [model1, model2] evs
focus <- readMVar switch
moveObj proj view focus evs
-- -- bind shader and provide mvp for object1 and draw it
mmodel1 <- readMVar model1
bind sp
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel1)
2020-05-17 15:28:39 +00:00
2020-05-17 10:35:29 +00:00
-- the actual drawing happens here
2020-05-22 00:29:16 +00:00
draw vao ibo sp
2020-08-10 13:09:23 +00:00
-- -- bind shader and provide mvp for object2 and draw it
mmodel2 <- readMVar model2
bind sp
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel2)
-- the actual drawing happens here
draw vao ibo sp
2020-05-17 11:06:09 +00:00
err <- get GL.errors
when (not $ null err) (print $ "loop errors: " <> show err)
2020-05-17 04:40:30 +00:00
2020-05-22 21:48:40 +00:00
-- make GL finish things up
2020-05-22 21:59:29 +00:00
GL.flush
2020-05-17 04:40:30 +00:00
-- 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!"