{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Marshal.PortInfo
-- 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 ports.
-- Reference:
-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_port.html>
--------------------------------------------------------------------------------

{-# LANGUAGE ForeignFunctionInterface #-}
module Sound.ALSA.Sequencer.Marshal.PortInfo where


{-# LINE 20 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

import qualified Sound.ALSA.Sequencer.Marshal.Client as Client
import qualified Sound.ALSA.Sequencer.Marshal.Port as Port
import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue
import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr
import qualified Sound.ALSA.Sequencer.Area as Area
import qualified Sound.ALSA.Sequencer.Query as Query
import qualified Sound.ALSA.Sequencer.Utility as U
import qualified Sound.ALSA.Exception as Exc

import qualified Data.EnumSet as EnumSet

import qualified Foreign.C.Types as C
import Foreign.Ptr (Ptr, )
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.port_info" =<< malloc_ p
     fmap Cons (Area.newForeignPtr free =<< Area.peek p)

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

foreign import ccall unsafe "alsa/asoundlib.h &snd_seq_port_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_port_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 39 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

{- |
Create a new information area filled with data
about a specific port on our client.
-}
get :: Seq.T mode -> Port.T -> IO T
get h q =
  do status <- malloc
     Exc.checkResult_ "get_port_info"
       =<< with status (get_ h q)
     return status

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

{-# LINE 45 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
{- |
Set the information for the sequencer port
based on the data in the given information area.
-}
set :: Seq.T mode -> Port.T -> T -> IO ()
set h q info =
  Exc.checkResult_ "set_port_info" =<< with info (set_ h q)

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

{-# LINE 50 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

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

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_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_port_info_set_name"
  setName_ :: Area.Ptr T_ -> Area.CString -> IO ()


{-# LINE 53 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

getPortSpecified :: T -> IO Bool
getPortSpecified i =
  fmap (0 /=) $ with i getPortSpecified_

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

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

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


{-# LINE 55 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
getTimestamping :: T -> IO Bool
getTimestamping i =
  fmap (0 /=) $ with i getTimestamping_

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

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

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


{-# LINE 56 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
getTimestampReal :: T -> IO Bool
getTimestampReal i =
  fmap (0 /=) $ with i getTimestampReal_

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

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

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


{-# LINE 57 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

getPort :: T -> IO Port.T
getPort i =
  fmap Port.imp $ with i getPort_

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

setPort :: T -> Port.T -> IO ()
setPort i c =
  with i (flip setPort_ (Port.exp c))

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


{-# LINE 60 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
getClient :: T -> IO Client.T
getClient i =
  fmap Client.imp $ with i getClient_

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

setClient :: T -> Client.T -> IO ()
setClient i c =
  with i (flip setClient_ (Client.exp c))

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


{-# LINE 62 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
getCapability :: T -> IO Port.Cap
getCapability i =
  fmap (EnumSet.Cons . fromIntegral) $ with i getCapability_

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

setCapability :: T -> Port.Cap -> IO ()
setCapability i c =
  with i (flip setCapability_ ((fromIntegral . EnumSet.decons) c))

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


{-# LINE 64 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

getMidiChannels :: T -> IO Word
getMidiChannels i =
  fmap fromIntegral $ with i getMidiChannels_

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

setMidiChannels :: T -> Word -> IO ()
setMidiChannels i c =
  with i (flip setMidiChannels_ (fromIntegral c))

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


{-# LINE 67 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
getMidiVoices :: T -> IO Word
getMidiVoices i =
  fmap fromIntegral $ with i getMidiVoices_

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

setMidiVoices :: T -> Word -> IO ()
setMidiVoices i c =
  with i (flip setMidiVoices_ (fromIntegral c))

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


{-# LINE 69 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
getSynthVoices :: T -> IO Word
getSynthVoices i =
  fmap fromIntegral $ with i getSynthVoices_

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

setSynthVoices :: T -> Word -> IO ()
setSynthVoices i c =
  with i (flip setSynthVoices_ (fromIntegral c))

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


{-# LINE 71 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

getTimestampQueue :: T -> IO Queue.T
getTimestampQueue i =
  fmap Queue.imp $ with i getTimestampQueue_

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

setTimestampQueue :: T -> Queue.T -> IO ()
setTimestampQueue i c =
  with i (flip setTimestampQueue_ (Queue.exp c))

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


{-# LINE 74 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}


-- | Get the address of the information area.
getAddr :: T -> IO Addr.T
getAddr i =
  Area.peek =<< with i getAddr_

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


{-# LINE 78 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}

-- | Set the port address.
setAddr :: T -> Addr.T -> IO ()
setAddr i c =
  with i (\iptr -> Area.with c (setAddr_ iptr))

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


{-# LINE 81 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}


-- read only
getReadUse :: T -> IO Word
getReadUse i =
  fmap fromIntegral $ with i getReadUse_

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


{-# LINE 85 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}
getWriteUse :: T -> IO Word
getWriteUse i =
  fmap fromIntegral $ with i getWriteUse_

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


{-# LINE 86 "src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc" #-}



-- | Create a new information area filled with data about an given
-- port on a given client.
getAny :: Seq.T mode -> Client.T -> Port.T -> IO T
getAny (Seq.Cons h) c p =
  do info <- malloc
     Exc.checkResult_ "getAny" =<<
       with info (getAny_ h (Client.exp c) (Port.exp p))
     return info

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

queryInit :: T -> IO ()
queryInit x =
  {-
  we cannot use setPort here,
  since Port uses an unsigned type and thus cannot represent -1
  -}
  with x (flip setPort_ (-1))

-- | Get information about the first port on our client.
queryFirst :: Seq.T mode -> IO T
queryFirst = Query.first

-- | Get information about the port with the next biggest identifier.
-- If a matching port is found, then its information is stored in the
-- given area and 'True' is returned.
queryNext :: Seq.T mode -> T -> IO Bool
queryNext (Seq.Cons h) info =
  U.checkResultQuery "PortInfo.queryNext" =<< with info (queryNext_ h)

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


instance Query.C T where
  init = queryInit
  next = queryNext