From 049383f68f04e735566436964a3d2f23c5c1cd82 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 6 Jun 2023 12:34:08 +1200
Subject: [PATCH] Fix colour output, add OpenGL cleanup.

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

diff --git a/lib/Graphics/Rendering/Rect/Backgrounds.hs b/lib/Graphics/Rendering/Rect/Backgrounds.hs
index 18cf113..6539cd6 100644
--- a/lib/Graphics/Rendering/Rect/Backgrounds.hs
+++ b/lib/Graphics/Rendering/Rect/Backgrounds.hs
@@ -9,7 +9,7 @@ import Control.Monad.IO.Class (MonadIO(..))
 baseFragmentShader = B8.pack $ unlines [
     "#version 330 core",
     "out vec4 fcolour;",
-    "in vec4 colour;",
+    "uniform vec4 colour;",
     "void main() { fcolour = colour; }"
   ]
 
diff --git a/lib/Graphics/Rendering/Rect/Types.hs b/lib/Graphics/Rendering/Rect/Types.hs
index 646f550..33c1b06 100644
--- a/lib/Graphics/Rendering/Rect/Types.hs
+++ b/lib/Graphics/Rendering/Rect/Types.hs
@@ -10,6 +10,7 @@ import qualified Data.Vector.Unboxed as UV
 import Typograffiti.GL
 import Graphics.GL.Core32
 import Graphics.GL.Types
+import Foreign.Marshal.Array (withArray)
 
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad (forM)
@@ -17,7 +18,7 @@ import System.Exit (die)
 
 import Data.Colour (AlphaColour, over, alphaChannel)
 import Data.Colour.SRGB (RGB(..), toSRGB)
-import Data.Colour.Names (white)
+import Data.Colour.Names (black)
 
 data Rect = Rect {
     left :: Float, top :: Float,
@@ -51,7 +52,7 @@ c rgba = u $ V4 r g b a
   where
     a = alphaChannel rgba
     -- Workaround for missing APIs in "colour" hackage.
-    RGB r g b = toSRGB $ over rgba white
+    RGB r g b = toSRGB $ over rgba black
 
 renderRectWith :: (MonadIO m, MonadIO n) => ByteString -> [String] ->
         n ([Uniform m] -> (a -> Rect) -> a -> M44 Float -> m ())
@@ -77,6 +78,9 @@ renderRectWith fragmentShader uniformNames = do
         drawVAO prog vao GL_TRIANGLES 6 -- 2 triangles
         glBindVertexArray 0
 
+        liftIO $ withArray [pbuf] $ glDeleteBuffers 1
+        liftIO $ withArray [vao] $ glDeleteVertexArrays 1
+
 liftGL :: MonadIO m => IO (Either String a) -> m a
 liftGL n = do
     ret <- liftIO n
-- 
2.30.2