diff options
Diffstat (limited to 'src/Vivant.hs')
| -rw-r--r-- | src/Vivant.hs | 116 |
1 files changed, 44 insertions, 72 deletions
diff --git a/src/Vivant.hs b/src/Vivant.hs index f5100e3..e786228 100644 --- a/src/Vivant.hs +++ b/src/Vivant.hs @@ -1,5 +1,4 @@ -{- - OpenGL examples in Haskell. +{- Vivant: Haskell OpenGL game. Copyright (C) 2020 Yann Herklotz This program is free software: you can redistribute it and/or modify @@ -25,85 +24,47 @@ import System.IO import SDL (($=)) import qualified SDL +import SDL.Time (ticks) import qualified Graphics.Rendering.OpenGL as GL -import Paths_learnopengl_haskell (getDataDir) +import Paths_vivant (getDataDir) +import Vivant.Shader (initShaders) screenWidth, screenHeight :: CInt (screenWidth, screenHeight) = (640, 480) main :: IO () main = do - SDL.initialize [SDL.InitVideo] - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL / OpenGL Example" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight, - SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL} - SDL.showWindow window - - _ <- SDL.glCreateContext window - (prog, attrib) <- initResources - - let loop = do - events <- SDL.pollEvents - let quit = elem SDL.QuitEvent $ map SDL.eventPayload events - - GL.clear [GL.ColorBuffer] - draw prog attrib - SDL.glSwapWindow window - - unless quit loop - - loop - - SDL.destroyWindow window - SDL.quit - -initResources :: IO (GL.Program, GL.AttribLocation) -initResources = do - datadir <- getDataDir - -- compile vertex shader - vs <- GL.createShader GL.VertexShader - vsSource <- BS.readFile $ datadir <> "/shaders/triangle.vert" - GL.shaderSourceBS vs $= vsSource - GL.compileShader vs - vsOK <- GL.get $ GL.compileStatus vs - unless vsOK $ do - hPutStrLn stderr "Error in vertex shader\n" - exitFailure - - -- Do it again for the fragment shader - fs <- GL.createShader GL.FragmentShader - fsSource <- BS.readFile $ datadir <> "/shaders/triangle.frag" - GL.shaderSourceBS fs $= fsSource - GL.compileShader fs - fsOK <- GL.get $ GL.compileStatus fs - unless fsOK $ do - hPutStrLn stderr "Error in fragment shader\n" - exitFailure - - program <- GL.createProgram - GL.attachShader program vs - GL.attachShader program fs - GL.attribLocation program "coord2d" $= GL.AttribLocation 0 - GL.linkProgram program - linkOK <- GL.get $ GL.linkStatus program - GL.validateProgram program - status <- GL.get $ GL.validateStatus program - unless (linkOK && status) $ do - hPutStrLn stderr "GL.linkProgram error" - plog <- GL.get $ GL.programInfoLog program - putStrLn plog - exitFailure - GL.currentProgram $= Just program + SDL.initialize [SDL.InitVideo] + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL / OpenGL Example" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight, + SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL} + SDL.showWindow window + + _ <- SDL.glCreateContext window + (prog, attrib) <- initShaders + + let loop = do + events <- SDL.pollEvents + let quit = elem SDL.QuitEvent $ map SDL.eventPayload events + + GL.clear [GL.ColorBuffer] + draw prog attrib + SDL.glSwapWindow window - return (program, GL.AttribLocation 0) + unless quit loop + + loop + + SDL.destroyWindow window + SDL.quit draw :: GL.Program -> GL.AttribLocation -> IO () draw program attrib = do @@ -112,6 +73,11 @@ draw program attrib = do GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral screenWidth) (fromIntegral screenHeight)) GL.currentProgram $= Just program + + ourColorLoc <- GL.uniformLocation program "ourColour" + tick <- ticks + GL.uniform ourColorLoc $= (GL.Vector4 (1::Float) (sin (fromIntegral tick / 500) / 2 + 0.5) 1 1) + GL.vertexAttribArray attrib $= GL.Enabled V.unsafeWith vertices $ \ptr -> GL.vertexAttribPointer attrib $= @@ -124,3 +90,9 @@ vertices = V.fromList [ 0.0, 0.8 , -0.8, -0.8 , 0.8, -0.8 ] + +texCoords :: V.Vector Float +texCoords = V.fromList [ 0, 0 + , 1, 0 + , 0.5, 1 + ] |