From 05c8b4fe321de441c69e39e7e6350feb556157e6 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 8 Jun 2023 16:37:31 +1200
Subject: [PATCH] Build texturing infrastructure.

---
 Mondrian.cabal                             | 4 +++-
 lib/Graphics/Rendering/Rect/Backgrounds.hs | 2 +-
 lib/Graphics/Rendering/Rect/Types.hs       | 5 +++--
 3 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/Mondrian.cabal b/Mondrian.cabal
index ee19b27..6da41a2 100644
--- a/Mondrian.cabal
+++ b/Mondrian.cabal
@@ -20,6 +20,7 @@ extra-source-files:  CHANGELOG.md
 library
   exposed-modules:     Graphics.Rendering.Rect,
                        Graphics.Rendering.Rect.Backgrounds,
+                       Graphics.Rendering.Rect.Image,
                        Graphics.Rendering.Rect.CSS,
                        Graphics.Rendering.Rect.CSS.Colour,
                        Graphics.Rendering.Rect.CSS.Backgrounds
@@ -27,7 +28,8 @@ library
   -- other-extensions:
   build-depends:       base >=4.13 && <4.14, stylist-traits >= 0.1.3.1 && < 1,
                        css-syntax, colour >= 2.3.6 && < 3, scientific, text,
-                       bytestring, typograffiti, linear, gl, vector, mtl
+                       bytestring, typograffiti, linear, gl, vector, mtl,
+                       unordered-containers, JuicyPixels >=3.0 && <4
   hs-source-dirs:      lib
   default-language:    Haskell2010
 
diff --git a/lib/Graphics/Rendering/Rect/Backgrounds.hs b/lib/Graphics/Rendering/Rect/Backgrounds.hs
index e7606fc..9e7a1f7 100644
--- a/lib/Graphics/Rendering/Rect/Backgrounds.hs
+++ b/lib/Graphics/Rendering/Rect/Backgrounds.hs
@@ -18,6 +18,6 @@ renderBackgrounds :: (MonadIO m, MonadIO n) =>
     n (Backgrounds -> Rects -> M44 Float -> m ())
 renderBackgrounds = do
     base <- renderRectWith baseFragmentShader ["colour"]
-    return $ \self -> base [c $ background self] $ headDef borderBox $ clip self
+    return $ \slf -> base [] [c $ background slf] $ headDef borderBox $ clip slf
 
 headDef def = fromMaybe def . listToMaybe
diff --git a/lib/Graphics/Rendering/Rect/Types.hs b/lib/Graphics/Rendering/Rect/Types.hs
index 8c7f304..5945fd8 100644
--- a/lib/Graphics/Rendering/Rect/Types.hs
+++ b/lib/Graphics/Rendering/Rect/Types.hs
@@ -19,6 +19,7 @@ import System.Exit (die)
 import Data.Colour (AlphaColour, over, alphaChannel)
 import Data.Colour.SRGB (RGB(..), toSRGB)
 import Data.Colour.Names (black)
+import Graphics.Rendering.Rect.Image (Texture)
 
 data Rect = Rect {
     left :: Float, top :: Float,
@@ -55,7 +56,7 @@ c rgba = u $ V4 r g b a
     RGB r g b = toSRGB $ over rgba black
 
 renderRectWith :: (MonadIO m, MonadIO n) => ByteString -> [String] ->
-        n ([Uniform m] -> (a -> Rect) -> a -> M44 Float -> m ())
+        n ([Texture] -> [Uniform m] -> (a -> Rect) -> a -> M44 Float -> m ())
 renderRectWith fragmentShader uniformNames = do
     vs <- liftGL $ compileOGLShader vertexShader GL_VERTEX_SHADER
     fs <- liftGL $ compileOGLShader fragmentShader GL_FRAGMENT_SHADER
@@ -65,7 +66,7 @@ renderRectWith fragmentShader uniformNames = do
     glUseProgram prog
     glEnable GL_BLEND
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-    return $ \uniforms getter rects mat -> do
+    return $ \_ uniforms getter rects mat -> do
         vao <- liftIO $ newBoundVAO
         pbuf <- newBuffer
         bufferGeometry 0 pbuf $ rect2geom $ getter rects
-- 
2.30.2