From 786e58ccbb05ced78c5421b53fbc469971d7db82 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Fri, 24 May 2019 21:11:14 -0400
Subject: Add curvature-coloring.

---
 PointPrimitiveRing.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

(limited to 'PointPrimitiveRing.hs')

diff --git a/PointPrimitiveRing.hs b/PointPrimitiveRing.hs
index 3647d4a..c458421 100644
--- a/PointPrimitiveRing.hs
+++ b/PointPrimitiveRing.hs
@@ -81,7 +81,7 @@ updateRingCommands r = do
                 front | front > cnt -> [(front - cnt,size)]
                       | otherwise   -> [(0,back), (front,cnt - front)]
     updateCommands (rStorage r) (rObject r) mask
-    readIORef (objCommands $ rObject r) >>= mapM_ print
+    -- readIORef (objCommands $ rObject r) >>= mapM_ print
     return ()
 
 pushBack :: Ring keys -> (keys -> Writer [DSum AttributeKey GLUniformValue] a) -> IO ()
@@ -93,5 +93,10 @@ pushBack r attrs = do
     when (sz < ringCapacity r) $ writeIORef (rSize r) (sz + 1)
     updateRingCommands r
 
+updateBack :: Ring keys -> (keys -> Writer [DSum AttributeKey GLUniformValue] a) -> IO ()
+updateBack r attrs = do
+    back <- readIORef $ rBack r
+    updateAttributes (mod (back - 1) (ringCapacity r)) $ attrs (rKeys r)
+
 updateRingUniforms :: GLStorage -> Ring keys -> IO ()
 updateRingUniforms _ _ = return ()
-- 
cgit v1.2.3