{-# LINE 1 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Sound.ALSA.Sequencer.Event.Remove (
  T,
  malloc,
  run,

  Condition,
  getCondition,
  setCondition,

  condInput,
  condOutput,
  condDest,
  condDestChannel,
  condTimeBefore,
  condTimeAfter,
  condTimeTick,
  condEventType,
  condIgnoreOff,
  condTagMatch,

  getQueue,
  getChannel,
  getEventType,
  getTag,
  getDest,
  getRealTime,
  getTickTime,

  setQueue,
  setChannel,
  setEventType,
  setTag,
  setDest,
  setRealTime,
  setTickTime,
  ) where




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.Marshal.Event as Event
import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime
import qualified Sound.ALSA.Sequencer.Marshal.Time as Time
import qualified Sound.ALSA.Sequencer.Area as Area
import qualified Sound.ALSA.Exception as Exc

import qualified Data.EnumBitSet as EnumSet
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.remove_events" =<< malloc_ p
     fmap Cons (Area.newForeignPtr free =<< Area.peek p)

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

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_remove_events_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_remove_events_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 58 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}

-- | Remove events according to the given conditions
run :: Seq.T mode -> T -> IO ()
run (Seq.Cons h) info =
  Exc.checkResult_ "EventRemove.run" =<< with info (run_ h)

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


getCondition :: T -> IO Condition
getCondition i =
  fmap EnumSet.Cons $ with i getCondition_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_remove_events_get_condition"
  getCondition_ :: Area.Ptr T_ -> IO C.CUInt

setCondition :: T -> Condition -> IO ()
setCondition i c =
  with i (flip setCondition_ (EnumSet.decons c))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_remove_events_set_condition"
  setCondition_  :: Area.Ptr T_ -> C.CUInt -> IO ()


{-# LINE 69 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}

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

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_remove_events_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_remove_events_set_queue"
  setQueue_  :: Area.Ptr T_ -> C.CInt -> IO ()


{-# LINE 71 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}
getChannel :: T -> IO Event.Channel
getChannel i =
  fmap (Event.Channel . fromIntegral) $ with i getChannel_

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

setChannel :: T -> Event.Channel -> IO ()
setChannel i c =
  with i (flip setChannel_ ((fromIntegral . Event.unChannel) c))

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


{-# LINE 72 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}
getEventType :: T -> IO Event.EType
getEventType i =
  fmap (Event.EType . fromIntegral) $ with i getEventType_

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

setEventType :: T -> Event.EType -> IO ()
setEventType i c =
  with i (flip setEventType_ ((fromIntegral . Event.unEType) c))

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


{-# LINE 73 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}
getTag :: T -> IO Event.Tag
getTag i =
  fmap (Event.Tag . fromIntegral) $ with i getTag_

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

setTag :: T -> Event.Tag -> IO ()
setTag i c =
  with i (flip setTag_ ((fromIntegral . Event.unTag) c))

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


{-# LINE 74 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}
getDest :: T -> IO Addr.T
getDest i =
  Area.peek =<< with i getDest_

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

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_remove_events_set_dest"
  setDest_  :: Area.Ptr T_ -> (Area.Ptr Addr.T) -> IO ()


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

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

setRealTime :: T -> RealTime.T -> IO ()
setRealTime i c =
  with i (\iptr -> Area.with c (setRealTime_ iptr))

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


{-# LINE 76 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}
getTickTime :: T -> IO Time.Tick
getTickTime i =
  Area.peek =<< with i getTickTime_

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_remove_events_get_time"
  getTickTime_ :: Area.Ptr T_ -> IO (Area.Ptr Time.Tick)

setTickTime :: T -> Time.Tick -> IO ()
setTickTime i c =
  with i (\iptr -> Area.with c (setTickTime_ iptr))

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_remove_events_set_time"
  setTickTime_  :: Area.Ptr T_ -> (Area.Ptr Time.Tick) -> IO ()


{-# LINE 77 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}


newtype ConditionFlag = ConditionFlag Int
   deriving (Eq, Ord, Enum)

type Condition = EnumSet.T C.CUInt ConditionFlag


condInput        :: Condition
condInput        = EnumSet.Cons 1
condOutput       :: Condition
condOutput       = EnumSet.Cons 2
condDest         :: Condition
condDest         = EnumSet.Cons 4
condDestChannel  :: Condition
condDestChannel  = EnumSet.Cons 8
condTimeBefore   :: Condition
condTimeBefore   = EnumSet.Cons 16
condTimeAfter    :: Condition
condTimeAfter    = EnumSet.Cons 32
condTimeTick     :: Condition
condTimeTick     = EnumSet.Cons 64
condEventType    :: Condition
condEventType    = EnumSet.Cons 128
condIgnoreOff    :: Condition
condIgnoreOff    = EnumSet.Cons 256
condTagMatch     :: Condition
condTagMatch     = EnumSet.Cons 512

{-# LINE 97 "src/Sound/ALSA/Sequencer/Event/Remove.hsc" #-}