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)
|
|
|
|
|
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
|
|
|
|
|
|
|
|
-- 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
|
|
|
|
|
2020-05-17 10:26:57 +00:00
|
|
|
-- define vertices (positions of the triangle corners) as List of Floats
|
2020-05-17 04:40:30 +00:00
|
|
|
let vertexPositions =
|
2020-05-17 10:26:57 +00:00
|
|
|
[ (-0.5), (-0.5) -- 0
|
|
|
|
, 0.5 , (-0.5) -- 1
|
|
|
|
, 0.5 , 0.5 -- 2
|
|
|
|
, (-0.5), 0.5 -- 3
|
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
|
|
|
|
|
|
|
-- create and bind buffer for vertices
|
|
|
|
buf <- GL.genObjectName
|
|
|
|
GL.bindBuffer GL.ArrayBuffer $= Just buf
|
|
|
|
|
2020-05-17 04:40:30 +00:00
|
|
|
-- 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)
|
2020-05-17 11:04:13 +00:00
|
|
|
( fromIntegral $ length vertexPositions * sizeOf (undefined :: GL.GLfloat)
|
2020-05-17 04:40:30 +00:00
|
|
|
-- 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
|
|
|
|
|
2020-05-17 10:26:57 +00:00
|
|
|
-- 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)
|
2020-05-17 11:04:13 +00:00
|
|
|
( fromIntegral $ length indices * sizeOf (undefined :: GL.GLuint)
|
2020-05-17 10:26:57 +00:00
|
|
|
-- The pointer to the data
|
|
|
|
, ptr
|
|
|
|
-- The data's usage
|
|
|
|
, GL.StaticDraw
|
|
|
|
)
|
|
|
|
|
2020-05-17 04:40:30 +00:00
|
|
|
-- -- SHADERS
|
|
|
|
|
2020-05-17 08:59:15 +00:00
|
|
|
-- read in shaders from source file
|
|
|
|
vertSrc <- B.readFile "./res/shaders/vert.shader"
|
|
|
|
fragSrc <- B.readFile "./res/shaders/frag.shader"
|
|
|
|
|
|
|
|
sp <- createShaderProgram vertSrc fragSrc
|
2020-05-17 04:40:30 +00:00
|
|
|
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]
|
|
|
|
|
2020-05-17 10:35:29 +00:00
|
|
|
-- the actual drawing happens here
|
2020-05-17 10:26:57 +00:00
|
|
|
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
|
2020-05-17 04:40:30 +00:00
|
|
|
|
|
|
|
-- 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
|