{-# LINE 1 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Queue.Info
-- 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>
--------------------------------------------------------------------------------

module Sound.ALSA.Sequencer.Queue.Info
  ( T
  , get
  , set
  , copy
  , clone

  , getQueue
  , getName
  , getLocked
  , getOwner
  , getFlags

  , setName
  , setLocked
  , setOwner
  , setFlags
  ) where


{-# LINE 36 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}

import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Marshal.Client as Client
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 qualified Foreign.C.Types as C
import Data.Word (Word, )


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.queue_info" =<< malloc_ p
     fmap Cons (Area.newForeignPtr free =<< Area.peek p)

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

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_queue_info_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_queue_info_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 48 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}

get :: Seq.T mode -> Queue.T -> IO T
get h q =
  do status <- malloc
     Exc.checkResult_ "get_queue_info"
       =<< with status (get_ h q)
     return status

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_info"
  get_ :: Seq.T mode -> Queue.T -> Area.Ptr T_ -> IO C.CInt

{-# LINE 50 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}
set :: Seq.T mode -> Queue.T -> T -> IO ()
set h q info =
  Exc.checkResult_ "set_queue_info" =<< with info (set_ h q)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_info"
  set_ :: Seq.T mode -> Queue.T -> Area.Ptr T_ -> IO C.CInt

{-# LINE 51 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}


getName :: T -> IO String
getName i = Area.peekCString =<< with i getName_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_queue_info_get_name"
  getName_ :: Area.Ptr T_ -> IO Area.CString

setName :: T -> String -> IO ()
setName i c =
  Area.withCAString c $ \p -> with i (flip setName_ p)

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_queue_info_set_name"
  setName_ :: Area.Ptr T_ -> Area.CString -> IO ()


{-# LINE 54 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}
getLocked :: T -> IO Bool
getLocked i =
  fmap (0 /=) $ with i getLocked_

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

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

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


{-# LINE 55 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}

getOwner :: T -> IO Client.T
getOwner i =
  fmap Client.imp $ with i getOwner_

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

setOwner :: T -> Client.T -> IO ()
setOwner i c =
  with i (flip setOwner_ (Client.exp c))

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


{-# LINE 57 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}
getFlags :: T -> IO Word
getFlags i =
  fmap fromIntegral $ with i getFlags_

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

setFlags :: T -> Word -> IO ()
setFlags i c =
  with i (flip setFlags_ (fromIntegral c))

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


{-# LINE 58 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}


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

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


{-# LINE 62 "src/Sound/ALSA/Sequencer/Queue/Info.hsc" #-}