Event.hs

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

module Sound.ALSA.Sequencer.Event
  ( syncOutputQueue
  , input
  , inputPending
  , output
  , outputBuffer
  , outputDirect
  , outputPending
  , extractOutput
  , removeOutput
  , drainOutput
  , dropOutput
  , dropOutputBuffer
  , dropInput
  , dropInputBuffer

  , TimeStamp(..)
  , InstrCluster
  , Instr(..)
  , Sample(..)
  , Cluster(..)
  , Volume(..), volumeSame

  , Event.T(..), simple
  , Event.Data(..)
  , NoteEv(..), Note(..), simpleNote
  , CtrlEv(..), Ctrl(..)
  , CustomEv(..), Custom(..)
  , QueueEv(..)
  , AddrEv(..)
  , ConnEv(..), Connect
  , EmptyEv(..)
  ) where


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

import Foreign.C.Types (CInt, )
import Foreign.Ptr (Ptr, nullPtr, )
import Foreign.Marshal.Alloc (alloca, )
import Foreign.Storable (peek, )

import Data.Word (Word, Word8, )
import Data.Int (Int16, )


-- | Wait until all events of the client are processed.
syncOutputQueue :: Seq.T mode -> IO ()
syncOutputQueue (Seq.Cons h) =
  Exc.checkResult_ "syncOutputQueue" =<< snd_seq_sync_output_queue h

foreign import ccall safe "alsa/asoundlib.h snd_seq_sync_output_queue"
  snd_seq_sync_output_queue :: Ptr Seq.Core -> IO CInt


-- | Get an event from the input buffer.
-- If the input buffer is empty, then it is filled with data from the
-- sequencer queue.  If there is no data in the sequencer queue,
-- then the process is either put to sleep (if the sequencer is operating
-- in blocking mode), or we throw @EAGAIN@ (if the sequence is operating
-- in non-blocking mode).
--
-- We may also throw @ENOSPC@, which means that the sequencer queue
-- over-run and some events were lost (this clears the input buffer).
--
input :: Seq.AllowInput mode => Seq.T mode -> IO Event.T
input (Seq.Cons h) = alloca $ \p ->
  do Exc.checkResult_ "input" =<< snd_seq_event_input h p
     peek =<< peek p

foreign import ccall safe "alsa/asoundlib.h snd_seq_event_input"
  snd_seq_event_input :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt


checkResult :: String -> CInt -> IO Word
checkResult loc n =
   fmap fromIntegral $ Exc.checkResult loc n


-- | Returns the number of events in the input buffer.
-- If the input buffer is empty and the boolean argument is true,
-- then try to fill the input buffer with data from the sequencer queue.
-- See also: 'input'.

inputPending
  :: Seq.AllowInput mode
  => Seq.T mode
  -> Bool     -- ^ refill if empty?
  -> IO Word  -- ^ number of events in buffer
inputPending (Seq.Cons h) fill =
  checkResult "inputPending" =<< snd_seq_event_input_pending h (if fill then 1 else 0)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_input_pending"
  snd_seq_event_input_pending :: Ptr Seq.Core -> Int -> IO CInt



-- | Output an event and drain the buffer, if it became full.
-- Throws exceptions.
-- See also: 'outputDirect', 'outputBuffer',
--           'outputPending', 'drainOutput', 'dropOutput',
--           'extractOutput', 'removeEvents'

output :: Seq.AllowOutput mode
             => Seq.T mode
             -> Event.T
             -> IO Word   -- ^ the number of remaining events (or bytes?)
output (Seq.Cons h) e =
  Event.allocaEv e $ \p -> checkResult "output" =<< snd_seq_event_output h p

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



-- | Output an event without draining the buffer.
-- Throws @-EAGAIN@ if the buffer becomes full.
-- See also 'output'.

outputBuffer :: Seq.AllowOutput mode
                    => Seq.T mode
                    -> Event.T
                    -> IO Word  -- ^ the byte size of remaining events

outputBuffer (Seq.Cons h) e =
  Event.allocaEv e $ \p -> checkResult "outputBuffer" =<< snd_seq_event_output_buffer h p

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_output_buffer"
  snd_seq_event_output_buffer :: Ptr Seq.Core -> Ptr Event.T -> IO CInt


-- | Output an event directly to the sequencer, NOT through the output buffer.
-- If an error occurs, then we throw an exception.
-- See also 'output'.

outputDirect
  :: Seq.AllowOutput mode
  => Seq.T mode
  -> Event.T
  -> IO Word  -- ^ number of bytes sent to the sequencer

outputDirect (Seq.Cons h) e =
  Event.allocaEv e $ \p -> checkResult "outputDirect" =<< snd_seq_event_output_direct h p

foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output_direct"
  snd_seq_event_output_direct :: Ptr Seq.Core -> Ptr Event.T -> IO CInt


-- | Return the size (in bytes) of pending events on output buffer.
-- See also 'output'.
outputPending
  :: Seq.AllowOutput mode
  => Seq.T mode
  -> IO Word  -- ^ size of pending events (in bytes)
outputPending (Seq.Cons h) =
  fromIntegral `fmap` snd_seq_event_output_pending h

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


-- | Extract the first event in output buffer.
-- Throws an exception on error.
-- See also 'output'.
extractOutput
  :: Seq.AllowOutput mode
  => Seq.T mode
  -> IO Event.T   -- ^ the first event in the buffer (if one was present)
extractOutput (Seq.Cons h) =
  alloca $ \p -> do Exc.checkResult_ "extractOutput" =<< snd_seq_extract_output h p
                    peek =<< peek p

-- | Remove the first event in output buffer.
-- Throws an exception on error.
-- See also 'output'.
removeOutput :: Seq.AllowOutput mode
  => Seq.T mode -> IO ()
removeOutput (Seq.Cons h) = Exc.checkResult_ "removeOutput" =<< snd_seq_extract_output h nullPtr

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_extract_output"
  snd_seq_extract_output :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt


-- | Drain output buffer to sequencer.
-- This function drains all pending events on the output buffer.
-- The function returns immediately after the events are sent to the queues
-- regardless whether the events are processed or not.
-- To get synchronization with the all event processes,
-- use 'syncOutputQueue' after calling this function.
-- Throws an exception on error.
-- See also: 'output', 'syncOutputQueue'.

drainOutput
  :: Seq.AllowOutput mode
  => Seq.T mode
  -> IO Word -- ^ byte size of events remaining in the buffer.

drainOutput (Seq.Cons h) = checkResult "drainOutput" =<< snd_seq_drain_output h

foreign import ccall safe "alsa/asoundlib.h snd_seq_drain_output"
  snd_seq_drain_output :: Ptr Seq.Core -> IO CInt


-- | Remove events from both the user-space output buffer,
-- and the kernel-space sequencer queue.
-- See also: 'drainOutput', 'dropOutputBuffer', 'removeEvents'.
dropOutput
  :: Seq.AllowOutput mode
  => Seq.T mode -> IO ()
dropOutput (Seq.Cons h) = Exc.checkResult_ "dropOutput" =<< snd_seq_drop_output h

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


-- | Remove events from the user-space output buffer.
-- See also: 'dropOutput'.
dropOutputBuffer
  :: Seq.AllowOutput mode
  => Seq.T mode -> IO ()
dropOutputBuffer (Seq.Cons h) = Exc.checkResult_ "dropOutputBuffer" =<< snd_seq_drop_output_buffer h

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


-- | Remove events from both the user-space input buffer,
-- and the kernel-space sequencer queue.
-- See also: 'dropInputBuffer', 'removeEvents'.
dropInput
  :: Seq.AllowInput mode
  => Seq.T mode -> IO ()
dropInput (Seq.Cons h) = Exc.checkResult_ "dropInput" =<< snd_seq_drop_input h

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


-- | Remove events from the user-space input buffer.
-- See also: 'dropInput'.
dropInputBuffer
  :: Seq.AllowInput mode
  => Seq.T mode -> IO ()
dropInputBuffer (Seq.Cons h) = Exc.checkResult_ "dropInputBuffer" =<< snd_seq_drop_input_buffer h

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



-- | Make a note whose unspecified fields contain 0.
simpleNote
  :: Word8  -- ^ Channel.
  -> Word8  -- ^ Note.
  -> Word8  -- ^ Velocity.
  -> Event.Note
simpleNote c n v =
   Event.Note {
      Event.noteChannel = c,
      Event.noteNote = n,
      Event.noteVelocity = v,
      Event.noteOffVelocity = 0,
      Event.noteDuration = 0
   }

{- |
Construct an ALSA sequencer event from very few information.
Most fields are initialized with sensible defaults.
You may use this as a start and alter its fields for your special needs.

> (Event.simple myAddr (Event.simpleNote 0 60 64)) {Event.dest = destAddr}
-}
simple :: Addr.T -> Event.Data -> Event.T
simple src bdy = Cons
  { Event.highPriority = False
  , Event.tag = 0
  , Event.queue = Queue.direct
  , Event.timestamp = Event.TickTime 0
  , Event.source = src
  , Event.dest = Addr.subscribers
  , Event.body = bdy
  }

-- | Used for volume control: means do not change the volume.
volumeSame :: Int16
volumeSame = -1