Private.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Reactive.Banana.ALSA.Private where

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.Frameworks as RBF
import qualified Reactive.Banana.Switch as RBS

import qualified Sound.ALSA.Sequencer as SndSeq
import qualified Sound.ALSA.Sequencer.Client as Client
import qualified Sound.ALSA.Sequencer.Port as Port
import qualified Sound.ALSA.Sequencer.Queue as Queue
import qualified Sound.ALSA.Sequencer.Event as Event

import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.Trans.Reader as MR
import Control.Monad.IO.Class (MonadIO, )
import Control.Monad.Fix (MonadFix, )
import Control.Applicative (Applicative, )



data Handle =
   Handle {
      sequ :: SndSeq.T SndSeq.DuplexMode,
      client :: Client.T,
      portPublic, portPrivate :: Port.T,
      queue :: Queue.T
   }


newtype Reactor t a =
   Reactor {
      runReactor ::
         MR.ReaderT
            (RBF.AddHandler Event.T, Handle)
            (MS.StateT Schedule (RBS.Moment t))
            a
   } deriving (Functor, Applicative, Monad, MonadIO, MonadFix)


instance Process.Moment Reactor where
   liftMoment = Reactor . MT.lift . MT.lift

instance IxMonad.C Reactor where
   point = return
   bind = (>>=)

instance Time.Timed Reactor where
   ticksFromSeconds =
      return .
      Time.cons . Time.Ticks .
      round . (nano *) .
      Time.unSeconds . Time.decons


nano :: Num a => a
nano = 1000^(3::Int)


{-
We need this to identify received Echo events.
We could also use the Custom fields of the Echo event
and would get a much larger range of Schedules,
but unfortunately we cannot use the Custom values
for selectively removing events from the output queue.
This is needed in our variable speed beat generator.

In order to prevent shortage of Tags
we could reserve one tag for events that will never be canceled
and then use the Custom fields in order to further distinguish Echo messages.
-}
type Schedule = Event.Tag
{-
newtype Schedule = Schedule Word32
   deriving (Eq, Ord, Enum, Show)
-}