{-# LINE 1 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Queue.Status
-- 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.Status
  ( T
  , get
  , copy
  , clone

  , getQueue
  , getEvents
  , getTickTime
  , getRealTime
  ) where


{-# LINE 29 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}

import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime
import qualified Sound.ALSA.Sequencer.Marshal.Time as Time
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


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

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

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_queue_status_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_status_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 41 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}


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

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

{-# LINE 44 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}

getTickTime :: T -> IO Time.Tick
getTickTime i =
  fmap fromIntegral $ with i getTickTime_

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


{-# LINE 46 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}
getRealTime :: T -> IO RealTime.T
getRealTime i =
  Area.peek =<< with i getRealTime_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_queue_status_get_real_time"
  getRealTime_ :: Area.Ptr T_ -> IO (Area.Ptr RealTime.T)


{-# LINE 47 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}
getQueue :: T -> IO Queue.T
getQueue i =
  fmap Queue.imp $ with i getQueue_

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


{-# LINE 48 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}
getEvents :: T -> IO Int
getEvents i =
  fmap fromIntegral $ with i getEvents_

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


{-# LINE 49 "src/Sound/ALSA/Sequencer/Queue/Status.hsc" #-}

{-
This function shall return status bits of the queue,
but the ALSA headers do not define any bits.
I would prefer a data type that handles this bitfield.

#{get_int "status", "Status", "C.CUInt", "fromIntegral"}
-}