reactive-jack 0.2.0.1 → 0.3
raw patch · 3 files changed
+26/−42 lines, 3 filesdep ~reactive-bananadep ~reactive-midyim
Dependency ranges changed: reactive-banana, reactive-midyim
Files
- reactive-jack.cabal +4/−4
- src/Reactive/Banana/JACK/Example.hs +12/−18
- src/Reactive/Banana/JACK/Process.hs +10/−20
reactive-jack.cabal view
@@ -1,5 +1,5 @@ Name: reactive-jack-Version: 0.2.0.1+Version: 0.3 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -45,15 +45,15 @@ Source-Repository this type: darcs location: http://hub.darcs.net/thielema/reactive-jack/- tag: 0.2.0.1+ tag: 0.3 Flag splitBase description: Choose the new smaller, split-up base package. Library Build-Depends:- reactive-midyim >=0.2 && <0.3,- reactive-banana >=0.7 && <0.9,+ reactive-midyim >=0.3 && <0.4,+ reactive-banana >=1.1 && <1.2, midi >=0.2 && <0.3, jack >=0.7 && <0.8, event-list >=0.1.1 && < 0.2,
src/Reactive/Banana/JACK/Example.hs view
@@ -10,22 +10,20 @@ import qualified Reactive.Banana.MIDI.Time as Time import qualified Reactive.Banana.Combinators as RB-import qualified Reactive.Banana.Frameworks as RBF import qualified Sound.MIDI.Message.Class.Check as Check import qualified Sound.MIDI.Message as MidiMsg import Sound.MIDI.Message.Channel.Voice (Velocity, normalVelocity, ) import qualified Control.Monad.Trans.State as MS-import Control.Monad (liftM2, liftM3, )--- import Control.Applicative (pure, )+import Control.Monad (liftM2, liftM3, join, ) melody ::- RB.Event t (pitch, Velocity) ->- RB.Event t [Note.Boundary pitch Velocity]+ RB.Event (pitch, Velocity) ->+ Process.Reactor (RB.Event [Note.Boundary pitch Velocity]) melody =- fst .+ fmap fst . RBU.traverse [] (\(pc, v) -> do off <- MS.get@@ -35,28 +33,24 @@ time :: Rational -> Process.RelativeSeconds time = Time.relative "example" . Time.Seconds -ticks ::- (RBF.Frameworks t) =>- Rational -> Process.Reactor t Process.RelativeTicks+ticks :: Rational -> Process.Reactor Process.RelativeTicks ticks = Time.ticksFromSeconds . time getTempo ::- (Check.C ev, RBF.Frameworks t) =>- RB.Event t ev ->- Process.Reactor t- (RB.Behavior t Process.RelativeTicks, RB.Event t ev)+ (Check.C ev) =>+ RB.Event ev ->+ Process.Reactor (RB.Behavior Process.RelativeTicks, RB.Event ev) getTempo ctrl =+ join $ liftM3 (uncurry ProcessMidi.tempoCtrl Ctrl.tempoDefault) (ticks 0.15) (liftM2 (,) (ticks 0.5) (ticks 0.05)) (return ctrl) loop ::- (RBF.Frameworks t) =>- RB.Behavior t Process.AbsoluteTicks ->- RB.Event t MidiMsg.T -> Process.Reactor t (RB.Event t [MidiMsg.T])+ RB.Behavior Process.AbsoluteTicks ->+ RB.Event MidiMsg.T -> Process.Reactor (RB.Event [MidiMsg.T]) loop times input = do -- beat <- ProcessMidi.beat . fst =<< getTempo input beat <- ProcessMidi.beatVar times . fst =<< getTempo input- return $- fmap (map Note.fromBnd) $ melody $+ fmap (fmap (map Note.fromBnd)) $ melody $ fmap (const (Common.PitchChannel (Common.pitch 60) (Common.channel 0), normalVelocity)) beat
src/Reactive/Banana/JACK/Process.hs view
@@ -1,16 +1,14 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE Rank2Types #-} module Reactive.Banana.JACK.Process where import qualified Reactive.Banana.JACK.Common as Common import qualified Reactive.Banana.MIDI.Process as Process import qualified Reactive.Banana.MIDI.Time as Time-import qualified Reactive.Banana.MIDI.IndexedMonad as IxMonad import qualified Reactive.Banana.Combinators as RB import qualified Reactive.Banana.Frameworks as RBF-import qualified Reactive.Banana.Switch as RBS+import Reactive.Banana.Frameworks (Handler, ) import Reactive.Banana.Combinators ((<@>), ) import qualified Sound.JACK.Exception as JackExc@@ -58,18 +56,17 @@ newtype Schedule = Schedule Int deriving (Eq, Ord, Enum, Show) -newtype Reactor t a =+newtype Reactor a = Reactor {- runReactor :: ReaderT Context (MS.StateT Schedule (RBS.Moment t)) a+ runReactor :: ReaderT Context (MS.StateT Schedule RBF.MomentIO) a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix) -instance Process.Moment Reactor where- liftMoment = Reactor . MT.lift . MT.lift+instance RB.MonadMoment Reactor where+ liftMoment = Process.liftMomentIO . RB.liftMoment -instance IxMonad.C Reactor where- point = return- bind = (>>=)+instance Process.MomentIO Reactor where+ liftMomentIO = Reactor . MT.lift . MT.lift instance Time.Timed Reactor where ticksFromSeconds t = do@@ -101,19 +98,15 @@ run :: (JackExc.ThrowsErrno e) =>- (forall t.- (RBF.Frameworks t) =>- RB.Event t MidiMsg.T -> RB.Event t [MidiMsg.T]) ->+ (RB.Event MidiMsg.T -> RB.Event [MidiMsg.T]) -> ReaderT Common.Handle (Sync.ExceptionalT e IO) () run f = runM (\ _ts xs -> return $ f xs) runM :: (JackExc.ThrowsErrno e) =>- (forall t.- (RBF.Frameworks t) =>- RB.Behavior t AbsoluteTicks ->- RB.Event t MidiMsg.T -> Reactor t (RB.Event t [MidiMsg.T])) ->+ (RB.Behavior AbsoluteTicks ->+ RB.Event MidiMsg.T -> Reactor (RB.Event [MidiMsg.T])) -> ReaderT Common.Handle (Sync.ExceptionalT e IO) () runM f = do MR.ReaderT $ \h -> do@@ -141,9 +134,6 @@ Jack.withActivation (Common.client h) $ MT.lift $ Jack.waitForBreak ---type Handler a = a -> IO () viewQueueL ::