reactive-midyim 0.3 → 0.4
raw patch · 5 files changed
+28/−63 lines, 5 filesdep +reactive-banana-bunchdep −reactive-banana
Dependencies added: reactive-banana-bunch
Dependencies removed: reactive-banana
Files
- reactive-midyim.cabal +3/−3
- src/Reactive/Banana/MIDI/Pattern.hs +2/−2
- src/Reactive/Banana/MIDI/Process.hs +19/−38
- src/Reactive/Banana/MIDI/Time.hs +1/−1
- src/Reactive/Banana/MIDI/Utility.hs +3/−19
reactive-midyim.cabal view
@@ -1,5 +1,5 @@ Name: reactive-midyim-Version: 0.3+Version: 0.4 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -45,11 +45,11 @@ Source-Repository this type: darcs location: http://hub.darcs.net/thielema/reactive-midyim/- tag: 0.3+ tag: 0.4 Library Build-Depends:- reactive-banana >=1.1 && <1.2,+ reactive-banana-bunch >=1.0 && <1.1, midi >=0.2 && <0.3, event-list >=0.1 && < 0.2, non-negative >=0.1 && <0.2,
src/Reactive/Banana/MIDI/Pattern.hs view
@@ -8,8 +8,8 @@ import Reactive.Banana.MIDI.Common (splitFraction, ) import qualified Reactive.Banana.MIDI.Utility as RBU-import qualified Reactive.Banana.Combinators as RB-import Reactive.Banana.Combinators ((<@>), )+import qualified Reactive.Banana.Bunch.Combinators as RB+import Reactive.Banana.Bunch.Combinators ((<@>), ) import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg import Sound.MIDI.Message.Channel.Voice (Velocity, )
src/Reactive/Banana/MIDI/Process.hs view
@@ -6,7 +6,6 @@ Reactor(reserveSchedule), scheduleQueue, initialEvent,- unionM, beat, beatQuant, beatVar,@@ -44,9 +43,9 @@ PitchChannelVelocity(PitchChannelVelocity), fraction, ) -import qualified Reactive.Banana.Combinators as RB-import qualified Reactive.Banana.Frameworks as RBF-import Reactive.Banana.Combinators ((<@>), )+import qualified Reactive.Banana.Bunch.Combinators as RB+import qualified Reactive.Banana.Bunch.Frameworks as RBF+import Reactive.Banana.Bunch.Combinators ((<@>), ) import qualified Sound.MIDI.Message.Class.Construct as Construct import qualified Sound.MIDI.Message.Class.Check as Check@@ -146,9 +145,8 @@ -- (Queue that keeps track of events to schedule -- , duration of the new alarm if applicable) (eEchoEvent, _bQueue) <-- RBU.sequence (mempty, EventList.empty) $- RBU.union "scheduleQueue"- (fmap remove eEcho) (pure add <*> times <@> e)+ RBU.sequence (mempty, EventList.empty) $+ RB.union (fmap remove eEcho) (add <$> times <@> e) reactimate $ fmap snd eEchoEvent return $ RBU.mapMaybe fst eEchoEvent@@ -168,13 +166,6 @@ {- |-The second event stream is delayed by an infinitesimal amount.--}-unionM :: (MomentIO m) => RB.Event a -> RB.Event a -> m (RB.Event a)-unionM xs = liftMomentIO . RBU.unionM xs---{- | Generate a beat according to the tempo control. The input signal specifies the period between two beats. The output events hold the times, where they occur.@@ -289,7 +280,7 @@ (tempoInit, tempoChanges) <- liftMomentIO $- liftA2 (,) (RB.valueBLater tempo) (plainChanges tempo)+ liftA2 (,) (RB.valueBLater tempo) (RBF.plainChanges tempo) let next t = mapSnd (return . sendSingle) <$> beatVarNext t @@ -299,9 +290,7 @@ eEchoEvent <- liftM fst $ RBU.sequence (mempty, 0, tempoInit) $- RBU.union "beatVar"- (fmap next eEcho)- (fmap (flip change) time <@> tempoChanges)+ RB.union (next <$> eEcho) (flip change <$> time <@> tempoChanges) reactimate' $ fmap snd eEchoEvent return $ RBU.mapMaybe fst eEchoEvent@@ -328,11 +317,10 @@ fmap (Common.Future dt) delayAdd ::- (MomentIO m) => RelativeTicks m ->- RB.Event ev -> m (RB.Event (Common.Future m ev))+ RB.Event ev -> RB.Event (Common.Future m ev) delayAdd dt evs =- unionM (fmap Common.now evs) $ delay dt evs+ RB.union (fmap Common.now evs) $ delay dt evs {- |@@ -443,17 +431,9 @@ (fmap KeySet.toList set) ctrl -uniqueChanges ::- (MomentIO moment, Eq a) => RB.Behavior a -> moment (RB.Event a)-uniqueChanges x = liftMomentIO $ do- x0 <- RB.valueBLater x- xs <- plainChanges x- fmap RB.filterJust $- flip RBU.mapAdjacent x0 (\old new -> toMaybe (new/=old) new) xs-- {--TODO: I think we can use this for ALSA.+TODO:+I think plainChanges works for ALSA. Can we also use it for JACK? If not, we can create something of type @@ -461,12 +441,13 @@ and attach the Behavior values using (<@). -}-plainChanges :: RB.Behavior a -> RBF.MomentIO (RB.Event a)-plainChanges x = do- (evs, handle) <- RBF.newEvent- xs <- RBF.changes x- RBF.reactimate' $ fmap (fmap handle) xs- return evs+uniqueChanges ::+ (MomentIO moment, Eq a) => RB.Behavior a -> moment (RB.Event a)+uniqueChanges x = liftMomentIO $ do+ x0 <- RB.valueBLater x+ xs <- RBF.plainChanges x+ fmap RB.filterJust $+ flip RBU.mapAdjacent x0 (\old new -> toMaybe (new/=old) new) xs sweep ::@@ -687,7 +668,7 @@ let (initial, initIgnoreUntil) = makeSeq sets0 initEv <- initialEvent initial - liftM (RBU.union "trainer" initEv . fst) $+ liftM (RB.union initEv . fst) $ flip (RBU.traverse (sets0, [], Time.inc initIgnoreUntil mempty)) (fmap (,) times <@> evs0) $ \(time,ev) -> case Query.noteExplicitOff ev of
src/Reactive/Banana/MIDI/Time.hs view
@@ -1,6 +1,6 @@ module Reactive.Banana.MIDI.Time where -import qualified Reactive.Banana.Combinators as RB+import qualified Reactive.Banana.Bunch.Combinators as RB import qualified Numeric.NonNegative.Class as NonNeg
src/Reactive/Banana/MIDI/Utility.hs view
@@ -1,8 +1,7 @@ -- basic reactive functions that could as well be in reactive-banana module Reactive.Banana.MIDI.Utility where -import qualified Reactive.Banana.Combinators as RB-import qualified Reactive.Banana.Frameworks as RBF+import qualified Reactive.Banana.Bunch.Combinators as RB import qualified Control.Monad.Trans.State as MS import Control.Monad (liftM, liftM2, )@@ -30,21 +29,6 @@ mapMaybe (\(mb,a) -> maybe (Just a) (const Nothing) mb) x)) . fmap (\a -> (f a, a)) -union :: String -> RB.Event a -> RB.Event a -> RB.Event a-union name = RB.unionWith (error $ name ++ ": clashing events")--{- |-The second event stream is delayed by an infinitesimal amount.--}-unionM :: RB.Event a -> RB.Event a -> RBF.MomentIO (RB.Event a)-unionM xs = fmap (union "Utility.unionM" xs) . delayEps--delayEps :: RB.Event a -> RBF.MomentIO (RB.Event a)-delayEps xs = do- (evs, handle) <- RBF.newEvent- RBF.reactimate $ fmap handle xs- return evs- bypass :: (a -> Maybe b) -> (RB.Event a -> RB.Event c) ->@@ -52,7 +36,7 @@ RB.Event a -> RB.Event c bypass p fa fb evs = let (eb,ea) = partitionMaybe p evs- in union "bypass" (fb eb) (fa ea)+ in RB.union (fb eb) (fa ea) bypassM :: (Monad m) =>@@ -62,7 +46,7 @@ RB.Event a -> m (RB.Event c) bypassM p fa fb evs = let (eb,ea) = partitionMaybe p evs- in liftM2 (union "bypass") (fb eb) (fa ea)+ in liftM2 RB.union (fb eb) (fa ea) traverse :: (RB.MonadMoment m) =>