From 466cba7c57aa9d39221d8c8c6b2bb26b040007b8 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 27 Dec 2020 16:28:53 +0000 Subject: Add haskell files --- src/Vivant.hs | 116 +++++++++++++++++++------------------------------- src/Vivant/Noise.hs | 2 + src/Vivant/Shader.hs | 49 +++++++++++++++++++++ src/Vivant/Texture.hs | 19 +++++++++ 4 files changed, 114 insertions(+), 72 deletions(-) create mode 100644 src/Vivant/Noise.hs create mode 100644 src/Vivant/Shader.hs create mode 100644 src/Vivant/Texture.hs 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 + ] diff --git a/src/Vivant/Noise.hs b/src/Vivant/Noise.hs new file mode 100644 index 0000000..fafd21f --- /dev/null +++ b/src/Vivant/Noise.hs @@ -0,0 +1,2 @@ +module Vivant.Noise where + diff --git a/src/Vivant/Shader.hs b/src/Vivant/Shader.hs new file mode 100644 index 0000000..503d1b7 --- /dev/null +++ b/src/Vivant/Shader.hs @@ -0,0 +1,49 @@ +module Vivant.Shader (initShaders) where + +import SDL (($=)) +import qualified Graphics.Rendering.OpenGL as GL +import qualified Data.ByteString as BS +import System.Exit (exitFailure) +import System.IO (stderr, hPutStrLn) +import Control.Monad (unless) +import Paths_vivant (getDataDir) + +initShaders :: IO (GL.Program, GL.AttribLocation) +initShaders = 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 + + return (program, GL.AttribLocation 0) diff --git a/src/Vivant/Texture.hs b/src/Vivant/Texture.hs new file mode 100644 index 0000000..7328c87 --- /dev/null +++ b/src/Vivant/Texture.hs @@ -0,0 +1,19 @@ +module Vivant.Texture (initTexture, loadTexture) where + +import Codec.Picture.Jpg (decodeJpeg) +import Codec.Picture.Types (convertImage) +import qualified Graphics.Rendering.OpenGL as GL +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as V + +import Paths_vivant (getDataDir) + +initTexture = do + GL.textureWrapMode GL.Texture2D GL.S $= (GL.Mirrored, GL.Repeat) + GL.textureWrapMode GL.Texture2D GL.T $= (GL.Mirrored, GL.Repeat) + GL.textureBorderColor GL.Texture2D $= GL.Color4 1 1 1 1 + GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Linear') + +loadTexture = do + image <- BS.readFile $ datadir <> "/assets/wall.jpg" + convertImage $ decodeJpeg image -- cgit