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

  , getQueue
  , getTempo
  , getPPQ
  , getSkew
  , getSkewBase

  , setTempo
  , setPPQ
  , setSkew
  , setSkewBase
  ) where



import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue
import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
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 :: forall a. T -> (Ptr T_ -> IO a) -> IO a
with (Cons ForeignPtr T_
p) Ptr T_ -> IO a
f = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Area.withForeignPtr ForeignPtr T_
p Ptr T_ -> IO a
f

-- | Allocate an uninitialized object. (Not exported)
malloc :: IO T
malloc :: IO T
malloc = Area.alloca $ \p ->
  do Exc.checkResult_ String
"Sequencer.queue_tempo" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr T_) -> IO CInt
malloc_ Ptr (Ptr T_)
p
     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr T_ -> T
Cons (forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
Area.newForeignPtr FunPtr (Ptr T_ -> IO ())
free forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
Area.peek Ptr (Ptr T_)
p)

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

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_queue_tempo_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_tempo_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 :: T -> IO T
clone T
from =
  do T
to <- IO T
malloc
     T -> T -> IO ()
copy T
to T
from
     forall (m :: * -> *) a. Monad m => a -> m a
return T
to

instance Area.C T where
  malloc :: IO T
malloc = IO T
malloc
  copy :: T -> T -> IO ()
copy = T -> T -> IO ()
copy
  clone :: T -> IO T
clone = T -> IO T
clone



{-# LINE 47 "src/Sound/ALSA/Sequencer/Queue/Tempo.hsc" #-}

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

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

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

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

{-# LINE 50 "src/Sound/ALSA/Sequencer/Queue/Tempo.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_tempo_get_queue"
  getQueue_ :: Area.Ptr T_ -> IO C.CInt


{-# LINE 54 "src/Sound/ALSA/Sequencer/Queue/Tempo.hsc" #-}

-- RW
getTempo :: T -> IO Word
getTempo i =
  fmap fromIntegral $ with i getTempo_

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

setTempo :: T -> Word -> IO ()
setTempo i c =
  with i (flip setTempo_ (fromIntegral c))

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


{-# LINE 57 "src/Sound/ALSA/Sequencer/Queue/Tempo.hsc" #-}
getPPQ :: T -> IO Int
getPPQ i =
  fmap fromIntegral $ with i getPPQ_

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

setPPQ :: T -> Int -> IO ()
setPPQ i c =
  with i (flip setPPQ_ (fromIntegral c))

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


{-# LINE 58 "src/Sound/ALSA/Sequencer/Queue/Tempo.hsc" #-}
getSkew :: T -> IO Word
getSkew i =
  fmap fromIntegral $ with i getSkew_

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

setSkew :: T -> Word -> IO ()
setSkew i c =
  with i (flip setSkew_ (fromIntegral c))

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


{-# LINE 59 "src/Sound/ALSA/Sequencer/Queue/Tempo.hsc" #-}
getSkewBase :: T -> IO Word
getSkewBase i =
  fmap fromIntegral $ with i getSkewBase_

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

setSkewBase :: T -> Word -> IO ()
setSkewBase i c =
  with i (flip setSkewBase_ (fromIntegral c))

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


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