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

  , getQueue
  , getType
  , getResolution

  , setType
  , setResolution

  , Type(..)
  ) where


{-# LINE 34 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}

{-# LINE 35 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}

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

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

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_queue_timer_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_timer_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 46 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}

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

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

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

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

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


{-# LINE 53 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}

-- RW

getType :: T -> IO Type
getType i =
  fmap impType $ with i getType_

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

setType :: T -> Type -> IO ()
setType i c =
  with i (flip setType_ (expType c))

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


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

getResolution :: T -> IO Word
getResolution i =
  fmap fromIntegral $ with i getResolution_

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

setResolution :: T -> Word -> IO ()
setResolution i c =
  with i (flip setResolution_ (fromIntegral c))

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


{-# LINE 61 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}


data Type =
     Alsa
   | MidiClock
   | MidiTick
   deriving (Show, Eq, Ord, Enum)

expType :: Type -> C.CInt
expType t  = case t of
  Alsa       -> 0
{-# LINE 72 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}
  MidiClock  -> 1
{-# LINE 73 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}
  MidiTick   -> 2
{-# LINE 74 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}

impType :: C.CInt -> Type
impType t  = case t of
  0         -> Alsa
{-# LINE 78 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}
  1   -> MidiClock
{-# LINE 79 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}
  2    -> MidiTick
{-# LINE 80 "src/Sound/ALSA/Sequencer/Queue/Timer.hsc" #-}
  _ -> error ("QueueTimer.impType: unknown timer type (" ++ show t ++ ")")