module Reactive.Banana.JACK.Example where import qualified Reactive.Banana.JACK.Process as Process import qualified Reactive.Banana.MIDI.Controller as Ctrl import qualified Reactive.Banana.MIDI.Common as Common import qualified Reactive.Banana.MIDI.Process as ProcessMidi import qualified Reactive.Banana.MIDI.Utility as RBU import qualified Reactive.Banana.MIDI.Note as Note 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, ) melody :: RB.Event t (pitch, Velocity) -> RB.Event t [Note.Boundary pitch Velocity] melody = fst . RBU.traverse [] (\(pc, v) -> do off <- MS.get MS.put [Note.Boundary pc normalVelocity False] return $ off ++ [Note.Boundary pc v True]) time :: Rational -> Process.RelativeSeconds time = Time.relative "example" . Time.Seconds ticks :: (RBF.Frameworks t) => Rational -> Process.Reactor t 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) getTempo ctrl = 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]) loop times input = do -- beat <- ProcessMidi.beat . fst =<< getTempo input beat <- ProcessMidi.beatVar times . fst =<< getTempo input return $ fmap (map Note.fromBnd) $ melody $ fmap (const (Common.PitchChannel (Common.pitch 60) (Common.channel 0), normalVelocity)) beat