Merge pull request #254 from turion/fix_gloss_io

Fix gloss event clock again
turion · Oct 4, 2023 · 59efe9f · 59efe9f
2 parents cba1490 + a7991c2
commit 59efe9f
Showing 1 changed file with 3 additions and 3 deletions.
diff --git a/rhine-gloss/src/FRP/Rhine/Gloss/IO.hs b/rhine-gloss/src/FRP/Rhine/Gloss/IO.hs
@@ -24,6 +24,7 @@ where
 
 -- base
 import Control.Concurrent
+import Control.Monad (when)
 import Data.Functor (void)
 import Data.IORef
 
@@ -142,9 +143,8 @@ launchGlossThread GlossSettings {..} = do
     simStep diffTime vars@GlossEnv {timeVar, timeRef} = do
       time <- readIORef timeRef
       let !time' = time + diffTime
-      liftIO $ print time'
-      void $ tryPutMVar timeVar time'
-      writeIORef timeRef time'
+      timeUpdate <- tryPutMVar timeVar time'
+      when timeUpdate $ writeIORef timeRef time'
       return vars
   void $ liftIO $ forkIO $ playIO display backgroundColor stepsPerSecond vars getPic handleEvent simStep
   return vars