packages feed

rhine-gloss 1.6 → 1.7

raw patch · 5 files changed

+15/−17 lines, 5 filesdep ~rhinePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: rhine

API changes (from Hackage documentation)

- FRP.Rhine.Gloss.IO: GlossEnv :: MVar Float -> MVar Event -> IORef Picture -> IORef Float -> GlossEnv
+ FRP.Rhine.Gloss.IO: GlossEnv :: MVar (Seconds Float) -> MVar Event -> IORef Picture -> IORef (Seconds Float) -> GlossEnv
- FRP.Rhine.Gloss.IO: [timeRef] :: GlossEnv -> IORef Float
+ FRP.Rhine.Gloss.IO: [timeRef] :: GlossEnv -> IORef (Seconds Float)
- FRP.Rhine.Gloss.IO: [timeVar] :: GlossEnv -> MVar Float
+ FRP.Rhine.Gloss.IO: [timeVar] :: GlossEnv -> MVar (Seconds Float)

Files

Main.hs view
@@ -21,8 +21,8 @@ {- | Rotate the gear with a constant angular velocity.    Disregards all events. -}-sim :: (Monad m) => BehaviourF m Float [Event] Picture-sim = timeInfoOf sinceInit >>> arr (* 50) >>> arr gears+sim :: (Monad m) => BehaviourF m (Seconds Float) [Event] Picture+sim = timeInfoOf sinceInit >>> arr (getSeconds >>> (* 50)) >>> arr gears  main :: IO () main = do
README.md view
@@ -4,7 +4,6 @@ or rather the function `Graphics.Gloss.play`, enabling you to write `gloss` applications as signal functions. An example "gears" program, which you can run as `cabal run rhine-gloss-gears`-or `stack build && stack exec rhine-gloss-gears`, now becomes as simple as:  ```haskell@@ -34,5 +33,4 @@ Typically, this are the `GL`, `GLU` and `GLUT` libraries. (On Debian-like systems, `sudo apt-get install libgl1-mesa-dev libglu1-mesa-dev freeglut3-dev` should suffice.) -When building with `stack`, it is assumed that you have `nix-shell` installed,-which will automatically get these dependencies for you.+When developing with `nix develop`, these dependencies are installed automatically.
rhine-gloss.cabal view
@@ -1,7 +1,7 @@ -- Initial rhine-gloss.cabal generated by cabal init.  For further -- documentation, see http://haskell.org/cabal/users-guide/ name: rhine-gloss-version: 1.6+version: 1.7 synopsis: Gloss backend for Rhine description:   This package provides a simple wrapper for the `gloss` library,@@ -42,7 +42,7 @@     gloss >=1.12,     mmorph >=1.1,     monad-schedule >=1.6,-    rhine ^>=1.6,+    rhine ^>=1.7,     transformers >=0.5    hs-source-dirs: src
src/FRP/Rhine/Gloss/IO.hs view
@@ -62,10 +62,10 @@  -- | Concurrent variables needed to communicate with the gloss backend. data GlossEnv = GlossEnv-  { timeVar :: MVar Float+  { timeVar :: MVar (Seconds Float)   , eventVar :: MVar Event   , picRef :: IORef Picture-  , timeRef :: IORef Float+  , timeRef :: IORef (Seconds Float)   }  {- | Effects in the gloss backend@@ -124,7 +124,7 @@ data GlossEventClockIO = GlossEventClockIO  instance (MonadIO m) => Clock (GlossConcT m) GlossEventClockIO where-  type Time GlossEventClockIO = Float+  type Time GlossEventClockIO = Seconds Float   type Tag GlossEventClockIO = Event   initClock _ = return (constM getEvent, 0)     where@@ -147,7 +147,7 @@ data GlossSimClockIO = GlossSimClockIO  instance (MonadIO m) => Clock (GlossConcT m) GlossSimClockIO where-  type Time GlossSimClockIO = Float+  type Time GlossSimClockIO = Seconds Float   type Tag GlossSimClockIO = ()   initClock _ = return (constM getTime &&& arr (const ()), 0)     where@@ -190,7 +190,7 @@       return vars     simStep diffTime vars@GlossEnv {timeVar, timeRef} = do       time <- readIORef timeRef-      let !time' = time + diffTime+      let !time' = time + Seconds diffTime       -- We don't do this in a separate thread, because forkIO putMVar would create a race condition on putting the MVar,       -- which can lead to non-monotonous time updates.       tryPutMVar timeVar time'
src/FRP/Rhine/Gloss/Pure.hs view
@@ -48,7 +48,7 @@ -- * @gloss@ effects  -- | A pure monad in which all effects caused by the @gloss@ backend take place.-newtype GlossM a = GlossM {unGlossM :: YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a}+newtype GlossM a = GlossM {unGlossM :: YieldT (ReaderT (Seconds Float, Maybe Event) (Writer Picture)) a}   deriving (Functor, Applicative, Monad)  -- Would have liked to make this a derived instance, but for some reason deriving gets thrown off by the newtype@@ -80,9 +80,9 @@   _ <> _ = GlossClock  instance Clock GlossM GlossClock where-  type Time GlossClock = Float+  type Time GlossClock = Seconds Float   type Tag GlossClock = Maybe Event-  initClock _ = return (constM (GlossM $ yield >> lift ask) >>> (sumS *** Category.id), 0)+  initClock _ = return (constM (GlossM $ yield >> lift ask) >>> (sumN *** Category.id), 0)   {-# INLINE initClock #-}  instance GetClockProxy GlossClock@@ -114,7 +114,7 @@   IO () flowGlossClSF settings clsf = flowGloss settings $ clsf >-> arrMCl paintAll @@ GlossClock -type WorldAutomaton = Automaton Identity ((Float, Maybe Event), ()) (Picture, Maybe ())+type WorldAutomaton = Automaton Identity ((Seconds Float, Maybe Event), ()) (Picture, Maybe ())  -- | The main function that will start the @gloss@ backend and run the 'Rhine' flowGloss ::@@ -128,7 +128,7 @@     worldAutomaton :: WorldAutomaton     worldAutomaton = AutomatonWriter.runWriterS $ AutomatonReader.runReaderS $ hoistS (runYieldT . unGlossM) $ performOnFirstSample $ eraseClock rhine     stepWith :: (Float, Maybe Event) -> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)-    stepWith (diff, eventMaybe) (automaton, _) = let Result automaton' (picture, _) = runIdentity $ stepAutomaton automaton ((diff, eventMaybe), ()) in (automaton', picture)+    stepWith (diff, eventMaybe) (automaton, _) = let Result automaton' (picture, _) = runIdentity $ stepAutomaton automaton ((Seconds diff, eventMaybe), ()) in (automaton', picture)     getPic (_, pic) = pic     handleEvent event = stepWith (0, Just event)     simStep diff = stepWith (diff, Nothing)