DROP? Poke around with threadDelay in gloss

turion · Aug 9, 2020 · 1c57885 · 1c57885
1 parent 44ed64c
commit 1c57885
Showing 1 changed file with 6 additions and 3 deletions.
diff --git a/essence-of-live-coding-gloss/src/LiveCoding/Gloss.hs b/essence-of-live-coding-gloss/src/LiveCoding/Gloss.hs
@@ -80,10 +80,13 @@ glossHandle GlossSettings { .. } = Handle
   }
 
 getPicture :: GlossVars -> IO Picture
-getPicture GlossVars { .. } = readIORef glossPicRef
+getPicture GlossVars { .. } = do
+  threadDelay 10000
+  readIORef glossPicRef
 
 handleEvent :: Event -> GlossVars -> IO GlossVars
 handleEvent event vars@GlossVars { .. } = do
+  threadDelay 10000
   modifyIORef glossEventsRef (event :)
   return vars
 
@@ -105,9 +108,9 @@ glossWrapC glossSettings cell = proc a -> do
   liftCell pump -< (glossVars, a)
   where
     pump = proc (GlossVars { .. }, a) -> do
-      _      <- arrM takeMVar                         -< glossDTimeVar
+      dTime  <- arrM takeMVar                         -< glossDTimeVar
       events <- arrM $ flip atomicModifyIORef' ([], ) -< glossEventsRef
       (picture, b) <- runPictureT cell                -< (events, a)
       arrM (uncurry writeIORef)                       -< (glossPicRef, picture)
-      arrM threadDelay                                -< 1000 -- TODO Tweak for better performance
+      -- arrM threadDelay                                -< round $ 1000 * dTime -- TODO Tweak for better performance
       returnA                                         -< b