--------------------------------------------------------------------------------
-- |
-- Module    : Sound.ALSA.Sequencer.Queue
-- Copyright : (c) Henning Thielemann, 2010-2012
--             (c) Iavor S. Diatchki, 2007
-- License   : BSD3
--
-- Maintainer: Henning Thielemann
-- Stability : provisional
--
-- This module contains functions for working with sequencer queue.
-- Reference:
-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>
--------------------------------------------------------------------------------

{-# LANGUAGE ForeignFunctionInterface #-}
module Sound.ALSA.Sequencer.Queue
  ( -- * General Queue Functions
    Queue.T
  , Queue.direct
  , alloc
  , allocNamed
  , free
  , with
  , withNamed
  , control

  ) where

import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr
import qualified Sound.ALSA.Sequencer.Marshal.Event as Event
import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue
import qualified Sound.ALSA.Sequencer.Marshal.Time as Time
import qualified Sound.ALSA.Exception as Exc

import qualified Foreign.C.Types as C
import Foreign.C.String (CString, withCAString, )
import Foreign.Ptr (Ptr, )

import Control.Exception (bracket, )
import Control.Functor.HT (void, )


alloc :: Seq.T mode -> IO Queue.T -- ^ Queue.T identifier.
alloc :: forall mode. T mode -> IO T
alloc (Seq.Cons Ptr Core
h) =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> T
Queue.imp forall a b. (a -> b) -> a -> b
$ forall a. Integral a => String -> a -> IO a
Exc.checkResult String
"Queue.alloc" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Core -> IO CInt
alloc_ Ptr Core
h

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_queue"
  alloc_ :: Ptr Seq.Core -> IO C.CInt

with :: Seq.T mode -> (Queue.T -> IO a) -> IO a
with :: forall mode a. T mode -> (T -> IO a) -> IO a
with T mode
s = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall mode. T mode -> IO T
alloc T mode
s) (forall mode. T mode -> T -> IO ()
free T mode
s)


allocNamed :: Seq.T mode -> String -> IO Queue.T
allocNamed :: forall mode. T mode -> String -> IO T
allocNamed (Seq.Cons Ptr Core
h) String
x = forall a. String -> (CString -> IO a) -> IO a
withCAString String
x forall a b. (a -> b) -> a -> b
$ \CString
s ->
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> T
Queue.imp forall a b. (a -> b) -> a -> b
$ forall a. Integral a => String -> a -> IO a
Exc.checkResult String
"Queue.allocNamed" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Core -> CString -> IO CInt
allocNamed_ Ptr Core
h CString
s

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_named_queue"
  allocNamed_ :: Ptr Seq.Core -> CString -> IO C.CInt

withNamed :: Seq.T mode -> String -> (Queue.T -> IO a) -> IO a
withNamed :: forall mode a. T mode -> String -> (T -> IO a) -> IO a
withNamed T mode
s String
nm = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall mode. T mode -> String -> IO T
allocNamed T mode
s String
nm) (forall mode. T mode -> T -> IO ()
free T mode
s)


-- | Delete the specified queue.
free
  :: Seq.T mode   -- ^ Sequencer handle.
  -> Queue.T    -- ^ Queue.T identifier.
  -> IO ()
free :: forall mode. T mode -> T -> IO ()
free (Seq.Cons Ptr Core
h) T
q =
  forall a. Integral a => String -> a -> IO ()
Exc.checkResult_ String
"Queue.free" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Core -> CInt -> IO CInt
free_ Ptr Core
h (T -> CInt
Queue.exp T
q)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_free_queue"
  free_ :: Ptr Seq.Core -> C.CInt -> IO C.CInt


{- |
start/stop/continue a queue

In the prototype event you can provide additional information.
The prototype event does not need to be a queue control event,
this part is ignored anyway.
In the prototype event you may also specify a queue.
This is the queue that the timestamp of the prototype event refers to.
This way you can control the target queue using timing from another queue.
-}
control
  :: Seq.T mode    -- ^ Sequencer handle.
  -> Queue.T       -- ^ target Queue.T.
  -> Event.QueueEv
  -> Maybe Event.T -- ^ prototype event that may provide timestamp, source queue
  -> IO ()
control :: forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
control T mode
h T
q QueueEv
cmd Maybe T
me =
  case QueueEv
cmd of
    Event.QueueSetPosTick Tick
_ -> forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
controlCustom T mode
h T
q QueueEv
cmd Maybe T
me
    Event.QueueSetPosTime T
_ -> forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
controlCustom T mode
h T
q QueueEv
cmd Maybe T
me
    Event.QueueSkew Skew
_       -> forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
controlCustom T mode
h T
q QueueEv
cmd Maybe T
me
    QueueEv
_ -> forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
controlPlain T mode
h T
q QueueEv
cmd Maybe T
me

controlCustom, controlPlain ::
  Seq.T mode -> Queue.T -> Event.QueueEv -> Maybe Event.T -> IO ()
controlCustom :: forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
controlCustom T mode
h T
q QueueEv
cmd Maybe T
me =
  forall mode. T mode -> T -> IO ()
eventOutput T mode
h forall a b. (a -> b) -> a -> b
$
    case Maybe T
me of
      Maybe T
Nothing ->
        -- cf. Event.simple
        Event.Cons {
          highPriority :: Bool
Event.highPriority = Bool
False,
          tag :: Tag
Event.tag = Word8 -> Tag
Event.Tag Word8
0,
          queue :: T
Event.queue = T
Queue.direct,
          time :: T
Event.time = Stamp -> T
Time.consAbs forall a b. (a -> b) -> a -> b
$ Tick -> Stamp
Time.Tick Tick
0,
          source :: T
Event.source = T
Addr.unknown,
          dest :: T
Event.dest = T
Addr.systemTimer,
          body :: Data
Event.body = QueueEv -> T -> Data
Event.QueueEv QueueEv
cmd T
q
        }
      Just T
ev ->
        T
ev {
          dest :: T
Event.dest = T
Addr.systemTimer,
          body :: Data
Event.body = QueueEv -> T -> Data
Event.QueueEv QueueEv
cmd T
q
        }

eventOutput :: Seq.T mode -> Event.T -> IO ()
eventOutput :: forall mode. T mode -> T -> IO ()
eventOutput T mode
h T
e =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
  forall a. T -> (Ptr T -> IO a) -> IO a
Event.with T
e forall a b. (a -> b) -> a -> b
$ \Ptr T
p ->
     forall a. Integral a => String -> a -> IO a
Exc.checkResult String
"Queue.control.eventOutput" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall mode. T mode -> Ptr T -> IO CInt
eventOutput_ T mode
h Ptr T
p

foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output"
  eventOutput_ :: Seq.T mode -> Ptr Event.T -> IO C.CInt

controlPlain :: forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
controlPlain T mode
h T
q QueueEv
cmd Maybe T
me =
  forall a. Maybe T -> (Ptr T -> IO a) -> IO a
Event.withMaybe Maybe T
me forall a b. (a -> b) -> a -> b
$ \Ptr T
p ->
    let (EType
c,CInt
v) = QueueEv -> (EType, CInt)
Event.expQueueEv QueueEv
cmd
    in  forall a. Integral a => String -> a -> IO ()
Exc.checkResult_ String
"Queue.control"
          forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall mode. T mode -> CInt -> CInt -> CInt -> Ptr T -> IO CInt
control_ T mode
h (T -> CInt
Queue.exp T
q)
                 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ EType -> Word8
Event.unEType EType
c) CInt
v Ptr T
p

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_control_queue"
  control_ :: Seq.T mode -> C.CInt -> C.CInt -> C.CInt -> Ptr Event.T -> IO C.CInt