-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Sound/ProteaAudio.chs" #-}
{-#LANGUAGE ForeignFunctionInterface,CPP#-}


{-|
ProteaAudio is a stereo audio mixer/playback library for

* Linux /(PusleAudio)/

* Macintosh OS X /(CoreAudio)/

* Windows /(DirectSound)/
-}
module Sound.ProteaAudio (
    -- * Sample
    Sample(),
    Sound(),

    -- * Audio System Setup
    initAudio,
    finishAudio,

    -- * Main Mixer
    volume,
    soundActiveAll,
    soundStopAll,

    -- * Sample Loading
    loaderAvailable,
    sampleFromMemoryPcm,
    sampleFromMemoryWav,
    sampleFromMemoryOgg,
    sampleFromFile,
    sampleDestroy,

    -- * Sample Playback
    soundLoop,
    soundPlay,
    soundLoopOn,
    soundPlayOn,
    soundUpdate,
    soundStop,
    soundActive
 ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign
import Foreign.C
import Data.ByteString (ByteString, useAsCStringLen)

-- | Audio sample resource handle. A sample can be shared between multiple Sound tracks. (abstraction for data)
newtype Sample = Sample{ fromSample :: (C2HSImp.CULong) }

-- | Sound track handle. It is used to control the audio playback. (abstraction for playback)
newtype Sound = Sound{ fromSound :: (C2HSImp.CULong) }


-- | Initializes the audio system.
initAudio :: (Int) -- ^ the maximum number of sounds that are played parallely, at most 1024. Computation time is linearly correlated to this factor.
 -> (Int) -- ^ sample frequency of the playback in Hz. 22050 corresponds to FM radio 44100 is CD quality. Computation time is linearly correlated to this factor.
 -> (Int) -- ^ the number of bytes that are sent to the sound card at once. Low numbers lead to smaller latencies but need more computation time (thread switches). If a too small number is chosen, the sounds might not be played continuously. The default value 512 guarantees a good latency below 40 ms at 22050 Hz sample frequency.
 -> IO ((Bool)) -- ^ returns True on success

initAudio a1 a2 a3 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  initAudio'_ a1' a2' a3' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 71 "./Sound/ProteaAudio.chs" #-}


-- *

-- | Releases the audio device and cleans up resources.
finishAudio :: IO ()
finishAudio =
  finishAudio'_ >>
  return ()

{-# LINE 76 "./Sound/ProteaAudio.chs" #-}


-- | Checks if loader for this file type is available.
loaderAvailable :: (String) -- ^ file extension (e.g. ogg)
 -> IO ((Bool))
loaderAvailable a1 =
  C2HSImp.withCString a1 $ \a1' -> 
  loaderAvailable'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 82 "./Sound/ProteaAudio.chs" #-}



-- | Loads raw linear pcm sound sample from memory buffer.
_sampleFromMemoryPcm :: (Ptr CChar) -- ^ memory buffer pointer
 -> (Int) -- ^ memory buffer size in bytes
 -> (Int) -- ^ number of channels, e.g. 1 for mono, 2 for stereo.
 -> (Int) -- ^ sample rate, i.e. 44100 Hz
 -> (Int) -- ^ bits per sample, i.e. 8, 16, 32
 -> (Float) -- ^ volume
 -> IO ((Sample)) -- ^ returns handle

_sampleFromMemoryPcm a1 a2 a3 a4 a5 a6 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  let {a6' = realToFrac a6} in 
  _sampleFromMemoryPcm'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = Sample res} in
  return (res')

{-# LINE 94 "./Sound/ProteaAudio.chs" #-}


-- | Loads wav sound sample from memory buffer.
_sampleFromMemoryWav :: (Ptr CChar) -- ^ memory buffer pointer
 -> (Int) -- ^ memory buffer size in bytes
 -> (Float) -- ^ volume
 -> IO ((Sample)) -- ^ returns handle

_sampleFromMemoryWav a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = realToFrac a3} in 
  _sampleFromMemoryWav'_ a1' a2' a3' >>= \res ->
  let {res' = Sample res} in
  return (res')

{-# LINE 102 "./Sound/ProteaAudio.chs" #-}


-- | Loads ogg sound sample from memory buffer.
_sampleFromMemoryOgg :: (Ptr CChar) -- ^ memory buffer pointer
 -> (Int) -- ^ memory buffer size in bytes
 -> (Float) -- ^ volume
 -> IO ((Sample)) -- ^ returns handle

_sampleFromMemoryOgg a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = realToFrac a3} in 
  _sampleFromMemoryOgg'_ a1' a2' a3' >>= \res ->
  let {res' = Sample res} in
  return (res')

{-# LINE 110 "./Sound/ProteaAudio.chs" #-}


-- | Loads raw linear pcm sound sample from memory buffer.
sampleFromMemoryPcm :: ByteString -- ^ pcm sample data; array of pcm samples (signed 8 bit int, signed 16 bit int or 32 bit float)
                    -> Int -- ^ number of channels, e.g. 1 for mono, 2 for stereo.
                    -> Int -- ^ sample rate, i.e. 44100 Hz
                    -> Int -- ^ bits per sample, i.e. 8, 16, 32
                    -> Float -- ^ volume
                    -> IO Sample -- ^ return sample handle
sampleFromMemoryPcm pcmData channels sampleRate bitsPerSample volume =
  useAsCStringLen pcmData $ \(ptr, size) -> _sampleFromMemoryPcm ptr size channels sampleRate bitsPerSample volume

-- | Loads wav sound sample from memory buffer.
sampleFromMemoryWav :: ByteString -- ^ wav sample data
                    -> Float -- ^ volume
                    -> IO Sample -- ^ return sample handle
sampleFromMemoryWav wavData volume = useAsCStringLen wavData $ \(ptr, size) -> _sampleFromMemoryWav ptr size volume

-- | Loads ogg sound sample from memory buffer.
sampleFromMemoryOgg :: ByteString -- ^ ogg sample data
                    -> Float -- ^ volume
                    -> IO Sample -- ^ return sample handle
sampleFromMemoryOgg oggData volume = useAsCStringLen oggData $ \(ptr, size) -> _sampleFromMemoryOgg ptr size volume

-- | Loads a sound sample from file.
sampleFromFile :: (String) -- ^ sample filepath
 -> (Float) -- ^ volume
 -> IO ((Sample)) -- ^ returns handle

sampleFromFile a1 a2 =
  C2HSImp.withCString a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  sampleFromFile'_ a1' a2' >>= \res ->
  let {res' = Sample res} in
  return (res')

{-# LINE 139 "./Sound/ProteaAudio.chs" #-}


-- | Unloads a previously loaded sample from memory, invalidating the handle.
sampleDestroy :: (Sample) -> IO ((Bool))
sampleDestroy a1 =
  let {a1' = fromSample a1} in 
  sampleDestroy'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 142 "./Sound/ProteaAudio.chs" #-}


-- | Set main mixer volume.
volume :: (Float) -- ^ left
 -> (Float) -- ^ right
 -> IO ()
volume a1 a2 =
  let {a1' = realToFrac a1} in 
  let {a2' = realToFrac a2} in 
  volume'_ a1' a2' >>
  return ()

{-# LINE 149 "./Sound/ProteaAudio.chs" #-}


-- | Return the number of currently active sounds.
soundActiveAll :: IO ((Int))
soundActiveAll =
  soundActiveAll'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 152 "./Sound/ProteaAudio.chs" #-}


-- | Stops all sounds immediately.
soundStopAll :: IO ()
soundStopAll =
  soundStopAll'_ >>
  return ()

{-# LINE 155 "./Sound/ProteaAudio.chs" #-}


-- | Plays a specified sound sample continuously any free channel and sets its parameters.
soundLoop :: (Sample) -- ^ handle of a previously loaded sample
 -> (Float) -- ^ left volume
 -> (Float) -- ^ right volume
 -> (Float) -- ^ time difference between left and right channel in seconds. Use negative values to specify a delay for the left channel, positive for the right
 -> (Float) -- ^ pitch factor for playback. 0.5 corresponds to one octave below, 2.0 to one above the original sample
 -> IO ((Sound))
soundLoop a1 a2 a3 a4 a5 =
  let {a1' = fromSample a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  soundLoop'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = Sound res} in
  return (res')

{-# LINE 165 "./Sound/ProteaAudio.chs" #-}


-- | Plays a specified sound sample once any free channel and sets its parameters.
soundPlay :: (Sample) -- ^ handle of a previously loaded sample
 -> (Float) -- ^ left volume
 -> (Float) -- ^ right volume
 -> (Float) -- ^ time difference between left and right channel in seconds. Use negative values to specify a delay for the left channel, positive for the right
 -> (Float) -- ^ pitch factor for playback. 0.5 corresponds to one octave below, 2.0 to one above the original sample
 -> IO ((Sound))
soundPlay a1 a2 a3 a4 a5 =
  let {a1' = fromSample a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  soundPlay'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = Sound res} in
  return (res')

{-# LINE 175 "./Sound/ProteaAudio.chs" #-}


-- | Plays a specified sound sample once on a specific channel and sets its parameters.
soundPlayOn :: (Int) -- ^ number of the channel to use for playback with the first channel starting at 0
 -> (Sample) -- ^ handle of a previously loaded sample
 -> (Float) -- ^ left volume
 -> (Float) -- ^ right volume
 -> (Float) -- ^ time difference between left and right channel in seconds. Use negative values to specify a delay for the left channel, positive for the right
 -> (Float) -- ^ pitch factor for playback. 0.5 corresponds to one octave below, 2.0 to one above the original sample
 -> IO ((Sound))
soundPlayOn a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromSample a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  let {a6' = realToFrac a6} in 
  soundPlayOn'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = Sound res} in
  return (res')

{-# LINE 186 "./Sound/ProteaAudio.chs" #-}


-- | Plays a specified sound sample continuously on a specific channel and sets its parameters.
soundLoopOn :: (Int) -- ^ number of the channel to use for playback with the first channel starting at 0
 -> (Sample) -- ^ handle of a previously loaded sample
 -> (Float) -- ^ left volume
 -> (Float) -- ^ right volume
 -> (Float) -- ^ time difference between left and right channel in seconds. Use negative values to specify a delay for the left channel, positive for the right
 -> (Float) -- ^ pitch factor for playback. 0.5 corresponds to one octave below, 2.0 to one above the original sample
 -> IO ((Sound))
soundLoopOn a1 a2 a3 a4 a5 a6 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromSample a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  let {a6' = realToFrac a6} in 
  soundLoopOn'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = Sound res} in
  return (res')

{-# LINE 197 "./Sound/ProteaAudio.chs" #-}


-- | Updates parameters of a specified sound.
soundUpdate :: (Sound) -- ^ handle of a currently active sound (if sound has stopped, this is a no-op)
 -> (Float) -- ^ left volume
 -> (Float) -- ^ right volume
 -> (Float) -- ^ time difference between left and right channel in seconds. Use negative values to specify a delay for the left channel, positive for the right
 -> (Float) -- ^ pitch factor for playback. 0.5 corresponds to one octave below, 2.0 to one above the original sample
 -> IO ((Bool)) -- ^ return True in case the parameters have been updated successfully

soundUpdate a1 a2 a3 a4 a5 =
  let {a1' = fromSound a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  soundUpdate'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 207 "./Sound/ProteaAudio.chs" #-}


-- | Stops a specified sound immediately.
soundStop :: (Sound) -> IO ((Bool))
soundStop a1 =
  let {a1' = fromSound a1} in 
  soundStop'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 210 "./Sound/ProteaAudio.chs" #-}


-- | Checks if a specified sound is still active.
soundActive :: (Sound) -> IO ((Bool))
soundActive a1 =
  let {a1' = fromSound a1} in 
  soundActive'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 213 "./Sound/ProteaAudio.chs" #-}


foreign import ccall safe "Sound/ProteaAudio.chs.h initAudio"
  initAudio'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Sound/ProteaAudio.chs.h finishAudio"
  finishAudio'_ :: (IO ())

foreign import ccall safe "Sound/ProteaAudio.chs.h loaderAvailable"
  loaderAvailable'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))

foreign import ccall safe "Sound/ProteaAudio.chs.h _sampleFromMemoryPcm"
  _sampleFromMemoryPcm'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CFloat -> (IO C2HSImp.CULong)))))))

foreign import ccall safe "Sound/ProteaAudio.chs.h _sampleFromMemoryWav"
  _sampleFromMemoryWav'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CFloat -> (IO C2HSImp.CULong))))

foreign import ccall safe "Sound/ProteaAudio.chs.h _sampleFromMemoryOgg"
  _sampleFromMemoryOgg'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CFloat -> (IO C2HSImp.CULong))))

foreign import ccall safe "Sound/ProteaAudio.chs.h sampleFromFile"
  sampleFromFile'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CFloat -> (IO C2HSImp.CULong)))

foreign import ccall safe "Sound/ProteaAudio.chs.h sampleDestroy"
  sampleDestroy'_ :: (C2HSImp.CULong -> (IO C2HSImp.CInt))

foreign import ccall safe "Sound/ProteaAudio.chs.h volume"
  volume'_ :: (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall safe "Sound/ProteaAudio.chs.h soundActiveAll"
  soundActiveAll'_ :: (IO C2HSImp.CInt)

foreign import ccall safe "Sound/ProteaAudio.chs.h soundStopAll"
  soundStopAll'_ :: (IO ())

foreign import ccall safe "Sound/ProteaAudio.chs.h soundLoop"
  soundLoop'_ :: (C2HSImp.CULong -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CULong))))))

foreign import ccall safe "Sound/ProteaAudio.chs.h soundPlay"
  soundPlay'_ :: (C2HSImp.CULong -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CULong))))))

foreign import ccall safe "Sound/ProteaAudio.chs.h soundPlayOn"
  soundPlayOn'_ :: (C2HSImp.CUInt -> (C2HSImp.CULong -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CULong)))))))

foreign import ccall safe "Sound/ProteaAudio.chs.h soundLoopOn"
  soundLoopOn'_ :: (C2HSImp.CUInt -> (C2HSImp.CULong -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CULong)))))))

foreign import ccall safe "Sound/ProteaAudio.chs.h soundUpdate"
  soundUpdate'_ :: (C2HSImp.CULong -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Sound/ProteaAudio.chs.h soundStop"
  soundStop'_ :: (C2HSImp.CULong -> (IO C2HSImp.CInt))

foreign import ccall safe "Sound/ProteaAudio.chs.h soundActive"
  soundActive'_ :: (C2HSImp.CULong -> (IO C2HSImp.CInt))