{-# LINE 1 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Subscribe
-- Copyright : (c) Henning Thielemann, 2012
--             (c) Dylan Simon, 2011
-- License   : BSD3
--
-- Stability : provisional
--
-- This module contains functions for working with subscriptions.
-- Reference:
-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>
--------------------------------------------------------------------------------

{-# LANGUAGE ForeignFunctionInterface #-}
module Sound.ALSA.Sequencer.Subscribe
  ( T

  , malloc
  , copy
  , clone

  , getSender
  , getDest
  , getQueue
  , getExclusive
  , getTimeUpdate
  , getTimeReal

  , setSender
  , setDest
  , setQueue
  , setExclusive
  , setTimeUpdate
  , setTimeReal

  , subscribePort
  , unsubscribePort

  , create
  , subscribe
  , unsubscribe
  ) where


{-# LINE 46 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}

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

import Data.Foldable (forM_, )

import qualified Foreign.C.Types as C
import Foreign.Ptr (Ptr, )


data T_
newtype T = Cons (Area.ForeignPtr T_)

with :: T -> (Area.Ptr T_ -> IO a) -> IO a
with (Cons p) f = Area.withForeignPtr p f

-- | Allocate an uninitialized object. (Not exported)
malloc :: IO T
malloc = Area.alloca $ \p ->
  do Exc.checkResult_ "Sequencer.port_subscribe" =<< malloc_ p
     fmap Cons (Area.newForeignPtr free =<< Area.peek p)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_malloc"
  malloc_ :: Area.Ptr (Area.Ptr T_) -> IO C.CInt

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_port_subscribe_free"
  free :: Area.FunPtr (Area.Ptr T_ -> IO ())

-- | Copy the content of one object into another.
copy
  :: T     -- ^ Destination
  -> T     -- ^ Source
  -> IO ()

copy to from =
  with to $ \p1 ->
  with from $ \p2 ->
    copy_ p1 p2

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_copy"
  copy_ :: Area.Ptr T_ -> Area.Ptr T_ -> IO ()

-- | Copy the content of an object to a newly created object.
clone :: T -> IO T
clone from =
  do to <- malloc
     copy to from
     return to

instance Area.C T where
  malloc = malloc
  copy = copy
  clone = clone



{-# LINE 60 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}

getQueue :: T -> IO Queue.T
getQueue i =
  fmap Queue.imp $ with i getQueue_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_queue"
  getQueue_ :: Area.Ptr T_ -> IO C.CInt

setQueue :: T -> Queue.T -> IO ()
setQueue i c =
  with i (flip setQueue_ (Queue.exp c))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_queue"
  setQueue_  :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 63 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}
getExclusive :: T -> IO Bool
getExclusive i =
  fmap (0 /=) $ with i getExclusive_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_exclusive"
  getExclusive_ :: Area.Ptr T_ -> IO C.CInt

setExclusive :: T -> Bool -> IO ()
setExclusive i c =
  let x = if c then 1 else 0
  in  with i (flip setExclusive_ x)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_exclusive"
  setExclusive_ :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 64 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}
getTimeUpdate :: T -> IO Bool
getTimeUpdate i =
  fmap (0 /=) $ with i getTimeUpdate_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_time_update"
  getTimeUpdate_ :: Area.Ptr T_ -> IO C.CInt

setTimeUpdate :: T -> Bool -> IO ()
setTimeUpdate i c =
  let x = if c then 1 else 0
  in  with i (flip setTimeUpdate_ x)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_time_update"
  setTimeUpdate_ :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 65 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}
getTimeReal :: T -> IO Bool
getTimeReal i =
  fmap (0 /=) $ with i getTimeReal_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_time_real"
  getTimeReal_ :: Area.Ptr T_ -> IO C.CInt

setTimeReal :: T -> Bool -> IO ()
setTimeReal i c =
  let x = if c then 1 else 0
  in  with i (flip setTimeReal_ x)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_time_real"
  setTimeReal_ :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 66 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}


-- | Get sender address of a port subscription
getSender :: T -> IO Addr.T
getSender i =
  Area.peek =<< with i getSender_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_sender"
  getSender_ :: Area.Ptr T_ -> IO (Area.Ptr Addr.T)


{-# LINE 70 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}

-- | Get destination address of a port subscription
getDest :: T -> IO Addr.T
getDest i =
  Area.peek =<< with i getDest_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_dest"
  getDest_ :: Area.Ptr T_ -> IO (Area.Ptr Addr.T)


{-# LINE 73 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}

-- | Set sender address of a port subscription
setSender :: T -> Addr.T -> IO ()
setSender i c =
  with i (\iptr -> Area.with c (setSender_ iptr))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_sender"
  setSender_  :: Area.Ptr T_ -> (Area.Ptr Addr.T) -> IO ()


{-# LINE 76 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}

-- | Set destination address of a port subscription
setDest :: T -> Addr.T -> IO ()
setDest i c =
  with i (\iptr -> Area.with c (setDest_ iptr))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_dest"
  setDest_  :: Area.Ptr T_ -> (Area.Ptr Addr.T) -> IO ()


{-# LINE 79 "src/Sound/ALSA/Sequencer/Subscribe.hsc" #-}

-- | Subscribe a port connection
subscribePort :: Seq.T mode -> T -> IO ()
subscribePort (Seq.Cons h) s =
  Exc.checkResult_ "subscribePort" =<< with s (subscribePort_ h)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_subscribe_port"
  subscribePort_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt

-- | Unsubscribe a connection between ports
unsubscribePort :: Seq.T mode -> T -> IO ()
unsubscribePort (Seq.Cons h) s =
  Exc.checkResult_ "unsubscribePort" =<< with s (unsubscribePort_ h)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_unsubscribe_port"
  unsubscribePort_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt

create :: Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO T
create sender dest excl time = do
  s <- malloc
  setSender s sender
  setDest s dest
  setExclusive s excl
  forM_ time $ \(queue, realtime) -> do
    setTimeUpdate s True
    setQueue s queue
    setTimeReal s realtime
  return s

-- | Subscribe a port connection: @'subscribeSimple' sender dest exclusive (Just (updatequeue, realtime))@
subscribe :: Seq.T mode -> Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO ()
subscribe ss sender dest excl time =
  subscribePort ss =<< create sender dest excl time

-- | Unsubscribe a port connection: @'unsubscribeSimple' sender dest@
unsubscribe :: Seq.T mode -> Addr.T -> Addr.T -> IO ()
unsubscribe ss sender dest =
  unsubscribePort ss =<< create sender dest False Nothing