{-# 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.Combinators as RB import qualified Reactive.Banana.Frameworks as RBF 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 a = Reactor { runReactor :: MR.ReaderT (RBF.AddHandler Event.T, Handle) (MS.StateT Schedule RBF.MomentIO) a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix) instance RB.MonadMoment Reactor where liftMoment = Process.liftMomentIO . RB.liftMoment instance Process.MomentIO Reactor where liftMomentIO = Reactor . MT.lift . MT.lift 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) -}