rhine-gloss 1.0 → 1.1

raw patch · 4 files changed

+28/−19 lines, 4 filesdep ~dunaidep ~rhinePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: dunai, rhine

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Main.hs +1/−1
• rhine-gloss.cabal +4/−4
• src/FRP/Rhine/Gloss/IO.hs +18/−14

@@ -1,5 +1,10 @@ # Revision history for rhine-gloss +## 1.1++* dunai-0.11 compatibility+* Fixed bug in IO backend+ ## 1.0  * Removed schedules. See the [page about changes in version 1](/version1.md).

@@ -20,7 +20,7 @@ {- | Rotate the gear with a constant angular velocity.    Disregards all events. -}-sim :: Monad m => BehaviourF m Float [Event] Picture+sim :: (Monad m) => BehaviourF m Float [Event] Picture sim = timeInfoOf sinceInit >>> arr (* 50) >>> arr gears  main :: IO ()

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                rhine-gloss-version:             1.0+version:             1.1 synopsis:            Gloss backend for Rhine description:   This package provides a simple wrapper for the `gloss` library,@@ -26,7 +26,7 @@ source-repository this   type:     git   location: https://github.com/turion/rhine.git-  tag:      v1.0+  tag:      v1.1   library@@ -38,8 +38,8 @@     FRP.Rhine.Gloss.Pure.Combined   build-depends:       base         >= 4.14 && < 4.18                      , transformers >= 0.5-                     , rhine        == 1.0-                     , dunai        ^>= 0.9+                     , rhine        == 1.1+                     , dunai        ^>= 0.11                      , gloss        >= 1.12                      , mmorph       >= 1.1                      , monad-schedule >= 0.1

@@ -24,6 +24,7 @@  -- base import Control.Concurrent+import Control.Monad (when) import Data.Functor (void) import Data.IORef @@ -52,7 +53,7 @@   { timeVar :: MVar Float   , eventVar :: MVar Event   , picRef :: IORef Picture-  , time :: Float+  , timeRef :: IORef Float   }  -- | Wraps the concurrent variables needed for communication with the @gloss@ backend.@@ -64,7 +65,7 @@   schedule actions = GlossConcT $ fmap (second $ map GlossConcT) $ schedule $ unGlossConcT <$> actions  withPicRef ::-  MonadIO m =>+  (MonadIO m) =>   (IORef Picture -> IO a) ->   GlossConcT m a withPicRef action = GlossConcT $ do@@ -72,15 +73,15 @@   liftIO $ action picRef  -- | Add a picture to the canvas.-paintIO :: MonadIO m => Picture -> GlossConcT m ()+paintIO :: (MonadIO m) => Picture -> GlossConcT m () paintIO pic = withPicRef $ \ref -> modifyIORef' ref (<> pic)  -- | Clear the canvas.-clearIO :: MonadIO m => GlossConcT m ()+clearIO :: (MonadIO m) => GlossConcT m () clearIO = withPicRef $ \ref -> writeIORef ref Blank  -- | Clear the canvas and then paint.-paintAllIO :: MonadIO m => Picture -> GlossConcT m ()+paintAllIO :: (MonadIO m) => Picture -> GlossConcT m () paintAllIO pic = clearIO >> paintIO pic  -- * Gloss clocks in 'IO'@@ -88,15 +89,16 @@ -- | Concurrently block on @gloss@ events. data GlossEventClockIO = GlossEventClockIO -instance MonadIO m => Clock (GlossConcT m) GlossEventClockIO where+instance (MonadIO m) => Clock (GlossConcT m) GlossEventClockIO where   type Time GlossEventClockIO = Float   type Tag GlossEventClockIO = Event   initClock _ = return (constM getEvent, 0)     where       getEvent = do-        GlossEnv {eventVar, time} <- GlossConcT ask+        GlossEnv {eventVar, timeRef} <- GlossConcT ask         liftIO $ do           event <- takeMVar eventVar+          time <- readIORef timeRef           return (time, event)  instance GetClockProxy GlossEventClockIO@@ -104,7 +106,7 @@ -- | Concurrently block on @gloss@ simulation ticks. data GlossSimClockIO = GlossSimClockIO -instance MonadIO m => Clock (GlossConcT m) GlossSimClockIO where+instance (MonadIO m) => Clock (GlossConcT m) GlossSimClockIO where   type Time GlossSimClockIO = Float   type Tag GlossSimClockIO = ()   initClock _ = return (constM getTime &&& arr (const ()), 0)@@ -127,21 +129,23 @@    you can use 'flowGlossIO' instead. -} launchGlossThread ::-  MonadIO m =>+  (MonadIO m) =>   GlossSettings ->   m GlossEnv launchGlossThread GlossSettings {..} = do-  vars <- liftIO $ GlossEnv <$> newEmptyMVar <*> newEmptyMVar <*> newIORef Blank <*> pure 0+  vars <- liftIO $ GlossEnv <$> newEmptyMVar <*> newEmptyMVar <*> newIORef Blank <*> newIORef 0   let     getPic GlossEnv {picRef} = readIORef picRef     -- Only try to put so this doesn't hang in case noone is listening for events or ticks     handleEvent event vars@GlossEnv {eventVar} = do       void $ tryPutMVar eventVar event       return vars-    simStep diffTime vars@GlossEnv {timeVar, time} = do+    simStep diffTime vars@GlossEnv {timeVar, timeRef} = do+      time <- readIORef timeRef       let !time' = time + diffTime-      void $ tryPutMVar timeVar time'-      return vars {time = 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 @@ -155,7 +159,7 @@    you can use 'flowGlossIO' instead. -} launchInGlossThread ::-  MonadIO m =>+  (MonadIO m) =>   GlossSettings ->   GlossConcT m a ->   m a