Add haskell files

4 files changed, 114 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
+                       ]
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