get actual triangle on screen

This commit is contained in:
nek0 2020-05-17 06:40:30 +02:00
parent adad6b62b7
commit 2c9681a624
4 changed files with 250 additions and 3 deletions

2
.gitignore vendored Normal file
View file

@ -0,0 +1,2 @@
dist-newstyle/
.*.swp

View file

@ -21,6 +21,10 @@ executable renderer
-- other-extensions:
build-depends: base >= 4.13.0.0 && < 5
, OpenGL
, OpenGLRaw
, sdl2 >= 2.5.0.0
, bytestring
, monad-loops
, random
hs-source-dirs: src
default-language: Haskell2010

View file

@ -4,14 +4,18 @@ let
inherit (nixpkgs) pkgs;
f = { mkDerivation, base, OpenGL, sdl2, stdenv }:
f = { mkDerivation, base, bytestring, monad-loops, OpenGL
, OpenGLRaw, random, sdl2, stdenv
}:
mkDerivation {
pname = "renderer";
version = "0.0.0.0";
src = ./.;
isLibrary = false;
isExecutable = true;
executableHaskellDepends = [ base OpenGL sdl2 ];
executableHaskellDepends = [
base bytestring monad-loops OpenGL OpenGLRaw random sdl2
];
license = stdenv.lib.licenses.gpl3;
};

View file

@ -1,4 +1,241 @@
{-# 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 System.Random (randomRIO)
main :: IO ()
main = putStrLn "Hello, Haskell!"
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
-- create and bind buffer for a triangle
buf <- GL.genObjectName
GL.bindBuffer GL.ArrayBuffer $= Just buf
-- define vertices (positions of the triangle corners) as List of Floats
let vertexPositions =
[ (-0.5), (-0.5)
, 0 , 0.5
, 0.5 , (-0.5)
] :: [Float]
-- 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 :: Float)
-- 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
-- -- SHADERS
-- define shader source code (usually these are separate files)
let vertexShader = mconcat
[ "#version 330 core\n"
, "\n"
, "layout(location = 0) in vec4 position;\n"
, "\n"
, "void main()\n"
, "{\n"
, " gl_Position = position;\n"
, "}\n"
] :: B.ByteString
fragmentShader = mconcat
[ "#version 330 core\n"
, "\n"
, "out vec4 color;\n"
, "\n"
, "void main()\n"
, "{\n"
, " color = vec4(0.0, 1.0, 0.0, 0.5);\n"
, "}\n"
] :: B.ByteString
sp <- createShaderProgram vertexShader fragmentShader
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]
-- tha actual drawing happens here
GL.drawArrays GL.Triangles 0 3
-- 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