Example.hs

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