diff --git a/assets/parrots.jpg b/assets/parrots.jpg deleted file mode 100644 index 97d1d7f..0000000 Binary files a/assets/parrots.jpg and /dev/null differ diff --git a/lib/hs-glsl b/lib/hs-glsl index 038946c..732a4ef 160000 --- a/lib/hs-glsl +++ b/lib/hs-glsl @@ -1 +1 @@ -Subproject commit 038946ca49f1369ca894f345cc55004d15aa1d19 +Subproject commit 732a4efd33d8a61ee1c5fde656a15d93f9c4686f diff --git a/package.nix b/package.nix index 5d49ded..2b6e414 100644 --- a/package.nix +++ b/package.nix @@ -9,10 +9,9 @@ "-O" "-Wall" "-Widentities" - "-Widentities" "-Wincomplete-record-updates" "-Wincomplete-uni-patterns" - "-Wmissing-export-lists" + # "-Wmissing-export-lists" "-Wmissing-home-modules" "-Wpartial-fields" "-Wredundant-constraints" diff --git a/src/Haskengl/Internal/IO/Shaders/Init.hs b/src/Haskengl/Internal/IO/Shaders/Init.hs index 47c683f..b031d5e 100644 --- a/src/Haskengl/Internal/IO/Shaders/Init.hs +++ b/src/Haskengl/Internal/IO/Shaders/Init.hs @@ -25,9 +25,9 @@ import Foreign.Storable import qualified Haskengl.Internal.Bindings.OpenGL as GL import Haskengl.Internal.Bindings.OpenGL (($=)) import qualified Haskengl.Internal.Bindings.GLFW as GLFW -import qualified Haskengl.Internal.Bindings.GLUtil as GLU import Haskengl.Internal.IO.Shaders.LoadShaders import Haskengl.Internal.IO.Shaders.Shaders +import Haskengl.Internal.IO.Textures import Haskengl.Internal.Types import Haskengl.Internal.Math.Classes @@ -114,9 +114,9 @@ createDisplayableObject :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [ createDisplayableObject array numComponents primitiveMode = do vao <- GL.genObjectName GL.bindVertexArrayObject $= Just vao - vbo_0 <- createVBO array numComponents $ GL.AttribLocation 0 - vbo_1 <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1 -- RGB - vbo_2 <- createVBO verticesUVArray 2 $ GL.AttribLocation 2 -- Texture + _ <- createVBO array numComponents $ GL.AttribLocation 0 + _ <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1 -- RGB + _ <- createVBO verticesUVArray 2 $ GL.AttribLocation 2 -- Texture return (DisplayableObject vao @@ -125,15 +125,6 @@ createDisplayableObject array numComponents primitiveMode = do primitiveMode ) --- | pull texture from filepath -loadTexture :: FilePath -> IO GL.TextureObject -loadTexture filepath = do - -- TODO handle Left case - Right texture <- GLU.readTexture filepath - GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear') - GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge) - return texture - -- | creates objects, shaders, etc. as appropriate initResources :: GLFW.Window -> IO DisplayableObjects initResources window = do @@ -154,15 +145,7 @@ initResources window = do GL.currentProgram $= Just program putTextLn "compiled shader program with success" - -- load texture - GL.activeTexture $= GL.TextureUnit 0 - let tex = "./assets/flag.png" - tx <- loadTexture tex - GL.texture GL.Texture2D $= GL.Enabled - GL.textureBinding GL.Texture2D $= Just tx - location1 <- GL.get $ GL.uniformLocation program "tex" - GL.uniform location1 $= (GL.TextureUnit 0) - putTextLn "loaded textures successfully" + addTexture "./assets/flag.png" 0 $ GL.uniformLocation program "tex" -- load projection matrix GLFW.swapBuffers window diff --git a/src/Haskengl/Internal/IO/Textures.hs b/src/Haskengl/Internal/IO/Textures.hs new file mode 100644 index 0000000..6faff5c --- /dev/null +++ b/src/Haskengl/Internal/IO/Textures.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.IO.Textures + - Description : loads textures + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.IO.Textures where + +import Relude + +import qualified Haskengl.Internal.Bindings.OpenGL as GL +import Haskengl.Internal.Bindings.OpenGL (($=)) +import qualified Haskengl.Internal.Bindings.GLUtil as GLU + +-- | pull texture from filepath +loadTextureFromFile :: FilePath -> IO GL.TextureObject +loadTextureFromFile filepath = do + -- TODO handle Left case + Right texture <- GLU.readTexture filepath + GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear') + GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge) + return texture + +-- | add texture to uniform +addTexture :: FilePath -> GL.GLuint -> GL.GettableStateVar GL.UniformLocation -> IO () +addTexture filepath textureUnitIndex uniformLocation = do + GL.activeTexture $= GL.TextureUnit textureUnitIndex + texture <- loadTextureFromFile filepath + GL.texture GL.Texture2D $= GL.Enabled + GL.textureBinding GL.Texture2D $= Just texture + location <- GL.get uniformLocation + GL.uniform location $= (GL.TextureUnit textureUnitIndex) diff --git a/src/Haskengl/Internal/IO/View.hs b/src/Haskengl/Internal/IO/View.hs index e4bc8b7..b3df8fd 100644 --- a/src/Haskengl/Internal/IO/View.hs +++ b/src/Haskengl/Internal/IO/View.hs @@ -27,14 +27,20 @@ view :: GLFW.Window -> Model -> IO () view window (Model objects) = do GL.clearColor $= backgroundColor GL.clear [GL.ColorBuffer] - displayObjects objects + _ <- displayObjects objects GLFW.swapBuffers window GLFW.pollEvents -- | draw an array of objects with OpenGL -displayObjects :: DisplayableObjects -> IO (DisplayableObjects) -displayObjects [] = return [] -displayObjects ((DisplayableObject vao numVertices _ primitiveMode):objects) = do +displayObjects :: DisplayableObjects -> IO () +displayObjects objects = do + _ <- displayObjects' objects + return () + +-- | draw an array of objects with OpenGL +displayObjects' :: DisplayableObjects -> IO (DisplayableObjects) +displayObjects' [] = return [] +displayObjects' ((DisplayableObject vao numVertices _ primitiveMode):objects) = do GL.bindVertexArrayObject $= Just vao GL.drawArrays primitiveMode 0 numVertices - displayObjects objects + displayObjects' objects diff --git a/src/Haskengl/Internal/IO/Window.hs b/src/Haskengl/Internal/IO/Window.hs index 6637362..2ae2c14 100644 --- a/src/Haskengl/Internal/IO/Window.hs +++ b/src/Haskengl/Internal/IO/Window.hs @@ -12,8 +12,6 @@ module Haskengl.Internal.IO.Window where import Relude -import qualified Haskengl.Internal.Bindings.OpenGL as GL -import Haskengl.Internal.Bindings.OpenGL (($=)) import qualified Haskengl.Internal.Bindings.GLFW as GLFW import Haskengl.Internal.Types (DisplayableObjects) import Haskengl.Internal.IO.Interrupts (keyPressed, shutdownWindow, resizeWindow) @@ -24,7 +22,7 @@ openWindow :: String -> IO (GLFW.Window, DisplayableObjects) openWindow title = do - GLFW.init + _ <- GLFW.init GLFW.defaultWindowHints GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4) GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5) diff --git a/src/Haskengl/Internal/Math/Classes.hs b/src/Haskengl/Internal/Math/Classes.hs index b99f697..4e03529 100644 --- a/src/Haskengl/Internal/Math/Classes.hs +++ b/src/Haskengl/Internal/Math/Classes.hs @@ -7,8 +7,6 @@ module Haskengl.Internal.Math.Classes where import Relude -import Foreign.Storable - import qualified Haskengl.Internal.Bindings.OpenGL as GL import Haskengl.Internal.Types @@ -35,11 +33,11 @@ instance Vertex (GL.Vertex4 GL.GLfloat) where instance Vertex (GL.Vertex3 GL.GLfloat) where toPoint (GL.Vertex3 x y z) = Point x y z 0 fromPoint (Point x y z 0) = Just $ GL.Vertex3 x y z - fromPoint (Point x y z _) = Nothing + fromPoint _ = Nothing fromPointLossy (Point x y z _) = GL.Vertex3 x y z instance Vertex (GL.Vertex2 GL.GLfloat) where toPoint (GL.Vertex2 x y) = Point x y 0 0 fromPoint (Point x y 0 0) = Just $ GL.Vertex2 x y - fromPoint (Point x y _ _) = Nothing + fromPoint _ = Nothing fromPointLossy (Point x y _ _) = GL.Vertex2 x y diff --git a/src/Haskengl/Internal/Update.hs b/src/Haskengl/Internal/Update.hs index 452ecbb..17f8217 100644 --- a/src/Haskengl/Internal/Update.hs +++ b/src/Haskengl/Internal/Update.hs @@ -10,11 +10,11 @@ -} module Haskengl.Internal.Update where -import Relude +-- import Relude import Haskengl.Internal.Types -- | update function update :: Model -> Model -update model@(Model objects) = +update model = model diff --git a/src/Haskengl/Main.hs b/src/Haskengl/Main.hs index 4aa626e..8264bb2 100644 --- a/src/Haskengl/Main.hs +++ b/src/Haskengl/Main.hs @@ -11,7 +11,6 @@ module Haskengl.Main (main) where import Relude -import Relude.Monad (forever) import Control.Concurrent (threadDelay) @@ -37,14 +36,14 @@ loop -> (Window -> Model -> IO ()) -- ^ View function -> Model -- ^ Model -> IO () -loop window update view model = +loop windowIn updateFun viewFun modelIn = do Just frameStart <- getTime - let model' = update model - view window model' + let modelOut = update modelIn + viewFun windowIn modelOut Just frameEnd <- getTime let dt = frameEnd - frameStart :: Double target = 1 / 60 :: Double when (dt < target) $ threadDelay $ floor $ (target - dt) * 1000 - loop window update view model' + loop windowIn updateFun viewFun modelOut