From a62275f853be9d9f43772fe1969c225ae43c3d62 Mon Sep 17 00:00:00 2001
From: mtgmonkey <mtgmonkey@nixos>
Date: Sun, 21 Dec 2025 12:23:57 +0100
Subject: merge development into master

---
 src/Game/Internal/LoadShaders.hs | 75 +++++++++++++++++++---------------------
 1 file changed, 36 insertions(+), 39 deletions(-)

(limited to 'src/Game/Internal/LoadShaders.hs')

diff --git a/src/Game/Internal/LoadShaders.hs b/src/Game/Internal/LoadShaders.hs
index ded2da9..86b549f 100644
--- a/src/Game/Internal/LoadShaders.hs
+++ b/src/Game/Internal/LoadShaders.hs
@@ -12,10 +12,11 @@
 -- Red Book Authors.
 --
 --------------------------------------------------------------------------------
-
-module Game.Internal.LoadShaders (
-   ShaderSource(..), ShaderInfo(..), loadShaders
-) where
+module Game.Internal.LoadShaders
+  ( ShaderSource(..)
+  , ShaderInfo(..)
+  , loadShaders
+  ) where
 
 import Control.Exception
 import Control.Monad
@@ -23,17 +24,15 @@ import qualified Data.ByteString as B
 import Graphics.Rendering.OpenGL
 
 --------------------------------------------------------------------------------
-
 -- | The source of the shader source code.
-
-data ShaderSource =
-     ByteStringSource B.ByteString
+data ShaderSource
+  = ByteStringSource B.ByteString
      -- ^ The shader source code is directly given as a 'B.ByteString'.
-   | StringSource String
+  | StringSource String
      -- ^ The shader source code is directly given as a 'String'.
-   | FileSource FilePath
+  | FileSource FilePath
      -- ^ The shader source code is located in the file at the given 'FilePath'.
-   deriving ( Eq, Ord, Show )
+  deriving (Eq, Ord, Show)
 
 getSource :: ShaderSource -> IO B.ByteString
 getSource (ByteStringSource bs) = return bs
@@ -41,49 +40,47 @@ getSource (StringSource str) = return $ packUtf8 str
 getSource (FileSource path) = B.readFile path
 
 --------------------------------------------------------------------------------
-
 -- | A description of a shader: The type of the shader plus its source code.
-
-data ShaderInfo = ShaderInfo ShaderType ShaderSource
-   deriving ( Eq, Ord, Show )
+data ShaderInfo =
+  ShaderInfo ShaderType ShaderSource
+  deriving (Eq, Ord, Show)
 
 --------------------------------------------------------------------------------
-
 -- | Create a new program object from the given shaders, throwing an
 -- 'IOException' if something goes wrong.
-
 loadShaders :: [ShaderInfo] -> IO Program
 loadShaders infos =
-   createProgram `bracketOnError` deleteObjectName $ \program -> do
-      loadCompileAttach program infos
-      linkAndCheck program
-      return program
+  createProgram `bracketOnError` deleteObjectName $ \program -> do
+    loadCompileAttach program infos
+    linkAndCheck program
+    return program
 
 linkAndCheck :: Program -> IO ()
 linkAndCheck = checked linkProgram linkStatus programInfoLog "link"
 
 loadCompileAttach :: Program -> [ShaderInfo] -> IO ()
 loadCompileAttach _ [] = return ()
-loadCompileAttach program (ShaderInfo shType source : infos) =
-   createShader shType `bracketOnError` deleteObjectName $ \shader -> do
-      src <- getSource source
-      shaderSourceBS shader $= src
-      compileAndCheck shader
-      attachShader program shader
-      loadCompileAttach program infos
+loadCompileAttach program (ShaderInfo shType source:infos) =
+  createShader shType `bracketOnError` deleteObjectName $ \shader -> do
+    src <- getSource source
+    shaderSourceBS shader $= src
+    compileAndCheck shader
+    attachShader program shader
+    loadCompileAttach program infos
 
 compileAndCheck :: Shader -> IO ()
 compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"
 
-checked :: (t -> IO ())
-        -> (t -> GettableStateVar Bool)
-        -> (t -> GettableStateVar String)
-        -> String
-        -> t
-        -> IO ()
+checked ::
+     (t -> IO ())
+  -> (t -> GettableStateVar Bool)
+  -> (t -> GettableStateVar String)
+  -> String
+  -> t
+  -> IO ()
 checked action getStatus getInfoLog message object = do
-   action object
-   ok <- get (getStatus object)
-   unless ok $ do
-      infoLog <- get (getInfoLog object)
-      fail (message ++ " log: " ++ infoLog)
+  action object
+  ok <- get (getStatus object)
+  unless ok $ do
+    infoLog <- get (getInfoLog object)
+    fail (message ++ " log: " ++ infoLog)
-- 
cgit v1.3.1