Permalink
Browse files

Small changes.

  • Loading branch information...
1 parent daca547 commit 79f6a82ba375c72e2b33d8eeaf184eb967678eb5 @HeinrichApfelmus committed Apr 8, 2012
Showing with 18 additions and 7 deletions.
  1. +13 −7 tomato-rubato/src/Sound/Tomato/Reactive.hs
  2. +5 −0 tomato-rubato/src/Sound/Tomato/Types.hs
@@ -8,14 +8,11 @@ module Sound.Tomato.Reactive (
-- TODO: Use reactive-banana for proper abstractions.
-- * Event
- Event, newEvent,
+ Event(..), newEvent, filterJust, filterE,
module Data.Functor,
-- * Timers
- Timer, withTimer, onTimer, setInterval, stopTimer,
-
- -- * Internal
- Event(..)
+ Timer, withTimer, onTimer, setFrequency, setInterval, stopTimer,
) where
import Control.Applicative
@@ -34,7 +31,9 @@ import Sound.Tomato.Types
Event
------------------------------------------------------------------------------}
-- | Stream of event occurrences.
-newtype Event a = Event { addHandler :: AddHandler a }
+newtype Event a = Event
+ { addHandler :: AddHandler a -- ^ Internal use only.
+ }
-- | A facility to register event handlers with. (Taken from reactive-banana)
type AddHandler a = (a -> IO ()) -> IO (IO ())
@@ -69,6 +68,9 @@ instance Functor Event where
filterJust :: Event (Maybe a) -> Event a
filterJust (Event addHandler) = Event $ \g -> addHandler (maybe (return ()) g)
+-- | Keep only values that satisfy the predicate
+filterE :: (a -> Bool) -> Event a -> Event a
+filterE p = filterJust . fmap (\x -> if p x then Just x else Nothing)
{-----------------------------------------------------------------------------
Timer
@@ -81,13 +83,17 @@ withTimer :: (Timer -> IO a) -> IO a
withTimer = bracket init stopTimer
where init = Timer <$> newEvent <*> newIORef Nothing
+-- | Set frequency and star the 'Timer'
+setFrequency :: Timer -> Frequency -> IO ()
+setFrequency t freq = setInterval t (1/freq)
+
-- | Set interval and start the 'Timer'
setInterval :: Timer -> Time -> IO ()
setInterval t@(Timer (_,fire) m) interval = do
stopTimer t
threadID <- forkIO $ forever $ do
- fire ()
threadDelay (ceiling $ 1e6 * interval)
+ fire ()
writeIORef m $ Just threadID
-- | Retrieve event from timer
@@ -5,8 +5,13 @@ module Sound.Tomato.Types where
type Name = String
+-- | Frequency in Hz.
type Frequency = Double
+hz, bpm :: Frequency
+hz = 1
+bpm = 1/60
+
-- | Time duration in seconds.
type Time = Double
ms, s :: Time

0 comments on commit 79f6a82

Please sign in to comment.