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


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


{-|
ProteaAudio-SDL is a stereo audio mixer and playback library for SDL /(platform independent)/
-}
module Sound.ProteaAudio.SDL (
    -- * Sample
    Sample(),
    Sound(),

    -- * Audio System Setup
    initAudio,
    finishAudio,

    -- * Main Mixer
    volume,
    soundActiveAll,
    soundStopAll,

    -- * Sample Loading
    loaderAvailable,
    sampleFromMemoryPcm,
    sampleFromMemoryWav,
    sampleFromMemoryOgg,
    sampleFromMemoryMp3,
    sampleFromMemory,
    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)
import qualified Data.ByteString as BS

-- | 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 76 "./Sound/ProteaAudio/SDL.chs" #-}


-- *

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

{-# LINE 81 "./Sound/ProteaAudio/SDL.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 87 "./Sound/ProteaAudio/SDL.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 99 "./Sound/ProteaAudio/SDL.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 107 "./Sound/ProteaAudio/SDL.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 115 "./Sound/ProteaAudio/SDL.chs" #-}


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

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

{-# LINE 123 "./Sound/ProteaAudio/SDL.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 =
  BS.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 = BS.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 = BS.useAsCStringLen oggData $ \(ptr, size) -> _sampleFromMemoryOgg ptr size volume

-- | Loads mp3 sound sample from memory buffer.
sampleFromMemoryMp3 :: ByteString -- ^ mp3 sample data
                    -> Float -- ^ volume
                    -> IO Sample -- ^ return sample handle
sampleFromMemoryMp3 mp3Data volume = BS.useAsCStringLen mp3Data $ \(ptr, size) -> _sampleFromMemoryMp3 ptr size volume

-- | Loads wav, ogg or mp3 sound sample from memory buffer (autodetects audio format).
sampleFromMemory :: ByteString -> Float -> IO Sample
sampleFromMemory bs volume
  | BS.take 4 bs == "RIFF"
  = sampleFromMemoryWav bs volume
  | BS.take 4 bs == "OggS"
  = sampleFromMemoryOgg bs volume
  | BS.take 3 bs == "ID3" || BS.take 2 bs `elem` ["\xFF\xFB", "\xFF\xF3", "\xFF\xF2"]
  = sampleFromMemoryMp3 bs volume
  | otherwise
  = error "Could not detect audio format"

-- | 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 170 "./Sound/ProteaAudio/SDL.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 173 "./Sound/ProteaAudio/SDL.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 180 "./Sound/ProteaAudio/SDL.chs" #-}


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

{-# LINE 183 "./Sound/ProteaAudio/SDL.chs" #-}


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

{-# LINE 186 "./Sound/ProteaAudio/SDL.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 196 "./Sound/ProteaAudio/SDL.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 206 "./Sound/ProteaAudio/SDL.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 217 "./Sound/ProteaAudio/SDL.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 228 "./Sound/ProteaAudio/SDL.chs" #-}


-- | Updates parameters of a specified sound.
soundUpdate :: (Sound) -- ^ handle of a currently active sound (if sound has stopped, this is a no-op)
 -> (Bool) -- ^ is paused state, this does not change the sound active state
 -> (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 a6 =
  let {a1' = fromSound a1} in 
  let {a2' = C2HSImp.fromBool a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  let {a6' = realToFrac a6} in 
  soundUpdate'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 239 "./Sound/ProteaAudio/SDL.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 242 "./Sound/ProteaAudio/SDL.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 245 "./Sound/ProteaAudio/SDL.chs" #-}


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

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

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

foreign import ccall safe "Sound/ProteaAudio/SDL.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/SDL.chs.h _sampleFromMemoryWav"
  _sampleFromMemoryWav'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CFloat -> (IO C2HSImp.CULong))))

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

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

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

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

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

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

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

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

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

foreign import ccall safe "Sound/ProteaAudio/SDL.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/SDL.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/SDL.chs.h soundUpdate"
  soundUpdate'_ :: (C2HSImp.CULong -> (C2HSImp.CInt -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CInt)))))))

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

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