From 1c578855c1e2ba3f65c6cf3ca86c6c8fc8e6e53e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Manuel=20B=C3=A4renz?= Date: Mon, 3 Aug 2020 19:37:47 +0200 Subject: [PATCH] DROP? Poke around with threadDelay in gloss --- essence-of-live-coding-gloss/src/LiveCoding/Gloss.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/essence-of-live-coding-gloss/src/LiveCoding/Gloss.hs b/essence-of-live-coding-gloss/src/LiveCoding/Gloss.hs index 4f04d332..a8659e19 100644 --- 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