From f2fbad12da41dd6111ffc4b14bf9e12977d50409 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Fri, 2 Aug 2019 02:00:30 -0400
Subject: Collect window invalidates into a single code path.

---
 MeshSketch.hs | 51 +++++++++++++++++++++++++++++----------------------
 1 file changed, 29 insertions(+), 22 deletions(-)

diff --git a/MeshSketch.hs b/MeshSketch.hs
index a2e4cbe..837a43d 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -326,6 +326,22 @@ data Realized = Realized
     , stSigs     :: [SignalHandlerId] -- Signals attached by onRealize.
     }
 
+invalidateGL :: MeshSketch -> IO ()
+invalidateGL mm = do
+    mwin <- widgetGetWindow (mmWidget mm)
+    forM_ mwin $ \win -> do
+        -- An explicit rectangle is invalidated in an attempt
+        -- to address an intermittent flickering of the groups pane.
+        -- It didn't eliminate the issue.  But I'm leaving this in
+        -- case it helped.
+        (wd,ht) <- do wd <- windowGetWidth win
+                      ht <- windowGetHeight win
+                      return (wd,ht)
+        rect <- newZeroRectangle
+        setRectangleWidth  rect wd
+        setRectangleHeight rect ht
+        windowInvalidateRect win (Just rect) False
+
 -- | Assumes the executable is nested somewhere in the source tree like so:
 --
 --    <src-tree>/<dist>/build/.../<executable>
@@ -490,9 +506,7 @@ onLoadedMesh mm mmesh = do
             forM_ mr $ \r -> do
                 x <- stateChangeMesh mesh mm (stStorage r) (stState r)
                 writeIORef (mmRealized mm) $ Just r { stState = x }
-                mwin <- widgetGetWindow (mmWidget mm)
-                forM_ mwin $ \win ->
-                    windowInvalidateRect win Nothing False
+                invalidateGL mm
     return False
 
 onRealize :: Pipeline -> PipelineSchema -> MeshSketch -> IO ()
@@ -652,8 +666,8 @@ translate4 p = (4><4)
     , 0 , 0 , 0 , 1
     ]
 
-updateCameraRotation :: IsWidget a => a -> State -> Double -> Double -> IO ()
-updateCameraRotation w st h k = do
+updateCameraRotation :: IO () -> State -> Double -> Double -> IO ()
+updateCameraRotation refresh st h k = do
     m <- readIORef (stDragFrom st)
     forM_ m $ \(df0,cam) -> do
         let d̂ = camDirection cam -- forward
@@ -687,9 +701,7 @@ updateCameraRotation w st h k = do
                     , camScreenToWorld = Nothing
                     }
         writeIORef (stCamera st) cam'
-        mwin <- widgetGetWindow w
-        forM_ mwin $ \win ->
-            windowInvalidateRect win Nothing False
+        refresh
 
 sanitizeCamera :: State -> IO ()
 sanitizeCamera st = do
@@ -828,7 +840,7 @@ onEvent mm realized ev = do
                         return ()
                 _ -> do
                     -- put (h,k)
-                    updateCameraRotation w st h k
+                    updateCameraRotation (invalidateGL mm) st h k
                     return ()
               Just (from,plane) -> do
                 -- doDragPlane
@@ -840,7 +852,7 @@ onEvent mm realized ev = do
                 writeIORef (stPlane st) $ Just $ plane G.// [(3,δ + plane!3)]
                 mwin <- widgetGetWindow w
                 forM_ mwin $ \win -> windowInvalidateRect win Nothing False
-                putStrLn ("drag-plane " ++ show (δ,p))
+                -- putStrLn ("drag-plane " ++ show (δ,p))
                 -- end doDragPlane
 
         EventTypeButtonPress -> do
@@ -868,7 +880,7 @@ onEvent mm realized ev = do
                     cam <- readIORef (stCamera st)
                     let d = computeDirection cam h k
                     writeIORef (stDragFrom st) $ Just (d,cam)
-                    put (etype,(h,k),d)
+                    -- put (etype,(h,k),d)
                     return ()
             else do
                 mplane <- readIORef (stPlane st)
@@ -892,7 +904,7 @@ onEvent mm realized ev = do
                     windowInvalidateRect win Nothing False
                     -}
                 _ -> do
-                    updateCameraRotation w st h k
+                    updateCameraRotation (invalidateGL mm) st h k
                     sanitizeCamera st
                     writeIORef (stDragFrom st) Nothing
               Just (from,plane) -> do
@@ -904,9 +916,8 @@ onEvent mm realized ev = do
                 p <- worldCoordinates st h k (Just $ n̂ `G.snoc` (from `dot` n̂))
                 let δ = dot (p - from) (G.init plane)
                 writeIORef (stPlane st) $ Just $ plane G.// [(3,δ + plane!3)]
-                mwin <- widgetGetWindow w
-                forM_ mwin $ \win -> windowInvalidateRect win Nothing False
-                putStrLn ("drag-plane " ++ show (δ,p))
+                invalidateGL mm
+                -- putStrLn ("drag-plane " ++ show (δ,p))
                 -- end doDragPlane
 
 
@@ -923,10 +934,8 @@ onEvent mm realized ev = do
                     , camWorldToScreen = Nothing
                     , camScreenToWorld = Nothing
                     }
-                mwin <- widgetGetWindow w
-                forM_ mwin $ \win ->
-                    windowInvalidateRect win Nothing False
-            put d
+                invalidateGL mm
+            -- put d
             return ()
 
         EventTypeKeyPress -> do
@@ -944,9 +953,7 @@ onEvent mm realized ev = do
                             "CubeMap" @= return skybox_id
                         writeIORef (stSkyTexture st) skybox_id
                         put (skyboxNames (stSkyboxes st) !! idx)
-                        mwin <- widgetGetWindow w
-                        forM_ mwin $ \win ->
-                            windowInvalidateRect win Nothing False
+                        invalidateGL mm
                         return ()
                 KEY_F -> do
                     put 'F'
-- 
cgit v1.2.3