{-# LINE 1 "Sound/Pulse/Simple.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "Sound/Pulse/Simple.hsc" #-}
-- |
-- Maintainer:  xanxys@gmail.com
-- Stability:   experimental
-- Portability: non-portable
--
-- Binding to PulseAudio Simple API
--
-- example(output 440Hz sine wave for 10 seconds):
-- 
-- @
--  main=do
--      s<-simpleNew Nothing \"example\" Play Nothing \"this is example application\"
--          (SampleSpec (F32 LittleEndian) 44100 1) Nothing Nothing
--      simpleWrite s [sin $ 2*pi*440*(t/44100)|t<-[1..44100*10]]
--      simpleDrain s
--      simpleFree s
-- @
module Sound.Pulse.Simple
    (simpleNew
    ,simpleFree
    ,simpleGetLatency
    ,simpleRead
    ,simpleReadRaw
    ,simpleWrite
    ,simpleWriteRaw
    ,simpleDrain
    ,simpleFlush
    ,Simple
    ,SampleSpec(..)
    ,SampleFormat(..)
    ,Compression(..)
    ,Endian(..)
    ,Direction(..)
    ,ChannelPosition(..)
    ,ChannelPan(..)
    ,BufferAttr(..))
    where
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable



{-# LINE 51 "Sound/Pulse/Simple.hsc" #-}

{-# LINE 52 "Sound/Pulse/Simple.hsc" #-}




foreign import ccall "pa_simple_new" pasNew
    :: CString -> CString -> CInt -> CString -> CString -> Ptr SampleSpec -> Ptr ChannelMap
    -> Ptr BufferAttr -> Ptr CInt -> IO (Ptr PASimple)
foreign import ccall "pa_simple_free" pasFree :: Ptr PASimple -> IO ()
foreign import ccall "pa_simple_write" pasWrite :: Ptr PASimple -> Ptr CUChar -> CInt -> Ptr CInt -> IO CInt
foreign import ccall "pa_simple_read" pasRead :: Ptr PASimple -> Ptr CUChar -> CInt -> Ptr CInt -> IO CInt
foreign import ccall "pa_simple_drain" pasDrain :: Ptr PASimple -> Ptr CInt -> IO CInt
foreign import ccall "pa_simple_get_latency" pasGetLatency :: Ptr PASimple -> Ptr CInt -> IO CUInt -- 64 bit dep.
foreign import ccall "pa_simple_flush" pasFlush :: Ptr PASimple -> IO CInt


newtype Simple=Simple (Ptr PASimple)
data Direction=Play|Record


data SampleSpec=SampleSpec SampleFormat Int Int -- ^ format, sampling rate, #channels

data SampleFormat
    =U8 Compression
    |S16 Endian
    |S24 Endian
    |S2432 Endian -- ^ 24 bit sample in 32 bit
    |S32 Endian
    |F32 Endian
data Compression=Raw|ALaw|MuLaw
data Endian=BigEndian|LittleEndian

newtype ChannelMap=ChannelMap [ChannelPosition]
data ChannelPosition
    =ChannelMono
    |ChannelNormal   ChannelPan
    |ChannelFront    ChannelPan
    |ChannelRear     ChannelPan
    |ChannelTopRear  ChannelPan
    |ChannelTopFront ChannelPan
    |ChannelLFE -- ^ low frequency effects
    |ChannelSubwoofer
    |ChannelFrontCenterLeft -- ^ equivalent to PA_CHANNEL_POSITION_FRONT_LEFT_OF_CENTER
    |ChannelFrontCenterRight
    |ChannelSideLeft
    |ChannelSideRight
    |ChannelTopCenter
    |ChannelAux Int -- 0-31


data ChannelPan=PanLeft|PanRight|PanCenter
    


data BufferAttr=BufferAttr (Maybe Int) (Maybe Int) (Maybe Int) (Maybe Int) (Maybe Int)
-- ^ max length, target length, prebuffer, minimum request, fragment size


-- hidden struct
data PASimple=PASimple







instance Enum Direction where
    toEnum=undefined
    fromEnum Play=1
    fromEnum Record=2

instance Storable SampleSpec where
    alignment _= 4
{-# LINE 125 "Sound/Pulse/Simple.hsc" #-}
    sizeOf _= (12)
{-# LINE 126 "Sound/Pulse/Simple.hsc" #-}
    poke ptr (SampleSpec fmt rate nch)=do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0)   ptr $ fromEnum fmt
{-# LINE 128 "Sound/Pulse/Simple.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4)     ptr rate
{-# LINE 129 "Sound/Pulse/Simple.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr nch
{-# LINE 130 "Sound/Pulse/Simple.hsc" #-}

instance Enum SampleFormat where
    toEnum=undefined
    fromEnum (U8 Raw)=0
    fromEnum (U8 ALaw)=1
    fromEnum (U8 MuLaw)=2
    fromEnum x=case x of
        S16 e -> 3+f e
        F32 e -> 5+f e
        S32 e -> 7+f e
        S24 e -> 9+f e
        S2432 e -> 11+f e
        where f LittleEndian=0; f BigEndian=1

instance Storable ChannelMap where
    alignment _= 4
{-# LINE 146 "Sound/Pulse/Simple.hsc" #-}
    sizeOf _= 4
{-# LINE 147 "Sound/Pulse/Simple.hsc" #-}
    poke ptr (ChannelMap ps)=withArray (map fromEnum ps) $ \_ps -> do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr $ length ps
{-# LINE 149 "Sound/Pulse/Simple.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr _ps
{-# LINE 150 "Sound/Pulse/Simple.hsc" #-}

instance Enum ChannelPosition where
    toEnum=undefined
    fromEnum x=case x of
        ChannelMono -> 0
        ChannelNormal p -> 1+f p
        ChannelFront p -> 1+f p
        ChannelRear p -> 4+f p
        ChannelLFE -> 7
        ChannelSubwoofer -> 7
        ChannelFrontCenterLeft -> 8
        ChannelFrontCenterRight -> 9
        ChannelSideLeft -> 10
        ChannelSideRight -> 11
        ChannelAux n -> 12+n
        ChannelTopCenter -> 44
        ChannelTopFront p -> 45+f p
        ChannelTopRear p -> 48+f p
        where f PanLeft=0; f PanRight=1; f PanCenter=2

instance Storable BufferAttr where
    alignment _= 4
{-# LINE 172 "Sound/Pulse/Simple.hsc" #-}
    sizeOf _= 4
{-# LINE 173 "Sound/Pulse/Simple.hsc" #-}
    poke ptr (BufferAttr ml tl pb mr fs)=do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr $ f ml
{-# LINE 175 "Sound/Pulse/Simple.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4)   ptr $ f tl
{-# LINE 176 "Sound/Pulse/Simple.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8)    ptr $ f pb
{-# LINE 177 "Sound/Pulse/Simple.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 12)    ptr $ f mr
{-# LINE 178 "Sound/Pulse/Simple.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 16)  ptr $ f fs
{-# LINE 179 "Sound/Pulse/Simple.hsc" #-}
        where f=maybe 0xffffffff id


 


-- | Establish connection to pulseaudio server. You usually don't need to specify optional fields.
simpleNew
    :: Maybe String -- ^ server name
    -> String -- ^ client name
    -> Direction -- ^ Play or Record
    -> Maybe String -- ^ name of sink or source
    -> String -- ^ description of client
    -> SampleSpec
    -> Maybe [ChannelPosition] -- ^ label channels
    -> Maybe BufferAttr -- ^ buffer size, etc
    -> IO Simple
simpleNew server client dir dev desc spec chmap attr=liftM Simple $
    withMaybeCString server $ \_server->
    withCString client $ \_client ->
    withMaybeCString dev $ \_dev ->
    withCString desc $ \_desc ->
    withStorable spec $ \_spec -> 
    withMaybeStorable (liftM ChannelMap chmap) $ \_chmap ->
    withMaybeStorable attr $ \_attr ->
        pasNew _server _client (fromIntegral $ fromEnum dir) _dev _desc _spec _chmap _attr nullPtr


-- | Read raw data from buffer.
simpleReadRaw :: Simple -> Int -> IO BS.ByteString
simpleReadRaw (Simple x) size=
    BS.create size $ \ptr->pasRead x (castPtr ptr) (fromIntegral size) nullPtr >> return ()

-- | Write raw data to buffer.
simpleWriteRaw :: Simple -> BS.ByteString -> IO ()
simpleWriteRaw (Simple x) (BS.PS ptr ofs size)=do
    withForeignPtr ptr $ \p->pasWrite x (castPtr p) (fromIntegral size) nullPtr
    return ()

-- | Read from buffer.
simpleRead :: Storable a => Simple -> Int -> IO [a]
simpleRead s n=simpleReadHack undefined s n

simpleReadHack :: Storable a => a -> Simple -> Int -> IO [a]
simpleReadHack dummy (Simple x) n=do
    let size=fromIntegral $ n*sizeOf dummy
    rs<-allocaArray n $ \ptr->pasRead x (castPtr ptr) size nullPtr >> peekArray n ptr
    return rs
    
-- | Write to buffer.
simpleWrite :: Storable a => Simple -> [a] -> IO ()
simpleWrite (Simple x) xs=do
    let n=length xs
        size=fromIntegral $ n*sizeOf (head xs)
    allocaArray n $ \ptr->pokeArray ptr xs >> pasWrite x (castPtr ptr) size nullPtr
    return ()

-- | Flush playback buffer
simpleFlush :: Simple -> IO ()
simpleFlush (Simple x)=pasFlush x >> return ()

-- | block until buffer is completely consumed
simpleDrain :: Simple -> IO ()
simpleDrain (Simple x)=pasDrain x nullPtr >> return ()

-- | Close the connection.
simpleFree :: Simple -> IO ()
simpleFree (Simple x)=pasFree x

-- | Get current latency in microseconds.
simpleGetLatency :: Simple -> IO Integer
simpleGetLatency (Simple x)=liftM fromIntegral $ pasGetLatency x nullPtr


withMaybeStorable :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybeStorable Nothing f=f nullPtr
withMaybeStorable (Just x) f=withStorable x f

withStorable :: Storable a => a -> (Ptr a -> IO b) -> IO b
withStorable x f=alloca (\ptr->poke ptr x>> f ptr)

withMaybeCString :: Maybe String -> (CString -> IO a) -> IO a
withMaybeCString Nothing f=f nullPtr
withMaybeCString (Just s) f=withCString s f