fix couple compiler warnings, modularise texture imports, remove parrots

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"

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
+  _ <- createVBO array numComponents $ GL.AttribLocation 0
-  vbo_1 <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1 -- RGB
+  _ <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1 -- RGB
-  vbo_2 <- createVBO verticesUVArray 2 $ GL.AttribLocation 2 -- Texture
+  _ <- 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
+  addTexture "./assets/flag.png" 0 $ GL.uniformLocation program "tex"
-  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"
 
   -- load projection matrix
   GLFW.swapBuffers window

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)

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 :: DisplayableObjects -> IO ()
-displayObjects [] = return []
+displayObjects objects = do
-displayObjects ((DisplayableObject vao numVertices _ primitiveMode):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

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)

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

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

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
+    let modelOut = update modelIn
-    view window model'
+    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