    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Sound.ALUT.Loaders
    -- Copyright   :  (c) Sven Panne 2005-2009
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  sven.panne@aedion.de
    -- Stability   :  stable
    -- Portability :  portable
    --
    --------------------------------------------------------------------------------

    module Sound.ALUT.Loaders (
       Phase, Duration, SoundDataSource(..),
       createBuffer, createBufferData,
       bufferMIMETypes, bufferDataMIMETypes
    )  where

    import Data.StateVar
    import Foreign.C.String ( peekCString, withCString )
    import Foreign.Marshal.Alloc ( alloca )
    import Foreign.Storable ( Storable(peek) )
    import Foreign.Ptr ( Ptr )
    import Sound.ALUT.Config (
       alut_CreateBufferFromFile, alut_CreateBufferFromFileImage,
       alut_CreateBufferHelloWorld, alut_CreateBufferWaveform,
       alut_LoadMemoryFromFile, alut_LoadMemoryFromFileImage,
       alut_LoadMemoryHelloWorld, alut_LoadMemoryWaveform,
       alut_GetMIMETypes )
    import Sound.ALUT.Constants (
       alut_WAVEFORM_SINE, alut_WAVEFORM_SQUARE, alut_WAVEFORM_SAWTOOTH,
       alut_WAVEFORM_IMPULSE, alut_WAVEFORM_WHITENOISE,
       alut_LOADER_BUFFER, alut_LOADER_MEMORY )
    import Sound.ALUT.Errors ( makeBuffer, throwIfNullPtr )
    import Sound.OpenAL.AL.BasicTypes ( ALsizei, ALenum, ALfloat )
    import Sound.OpenAL.AL.Buffer ( Buffer, MemoryRegion(..), BufferData(..) )
    import Sound.OpenAL.AL.Format ( unmarshalFormat )
    import Sound.OpenAL.ALC.Context ( Frequency )
    import System.IO ( FilePath )

    --------------------------------------------------------------------------------

    type Phase = Float

    type Duration = Float

    data SoundDataSource a =
         File FilePath
       | FileImage (MemoryRegion a)
       | HelloWorld
       | Sine Frequency Phase Duration
       | Square Frequency Phase Duration
       | Sawtooth Frequency Phase Duration
       | Impulse Frequency Phase Duration
       | WhiteNoise Duration
    #ifdef __HADDOCK__
    -- Help Haddock a bit, because it doesn't do any instance inference.
    instance Eq (SoundDataSource a)
    instance Ord (SoundDataSource a)
    instance Show (SoundDataSource a)
    #else
       deriving ( Eq, Ord, Show )
    #endif

    --------------------------------------------------------------------------------

    createBuffer :: SoundDataSource a -> IO Buffer
    createBuffer src = makeBuffer "createBuffer" $ case src of
       File filePath -> withCString filePath alut_CreateBufferFromFile
       FileImage (MemoryRegion buf size) -> alut_CreateBufferFromFileImage buf size
       HelloWorld -> alut_CreateBufferHelloWorld
       Sine f p d -> alut_CreateBufferWaveform alut_WAVEFORM_SINE f p d
       Square f p d -> alut_CreateBufferWaveform alut_WAVEFORM_SQUARE f p d
       Sawtooth f p d -> alut_CreateBufferWaveform alut_WAVEFORM_SAWTOOTH f p d
       Impulse f p d -> alut_CreateBufferWaveform alut_WAVEFORM_IMPULSE f p d
       WhiteNoise d -> alut_CreateBufferWaveform alut_WAVEFORM_WHITENOISE 1 0 d

    --------------------------------------------------------------------------------

    createBufferData :: SoundDataSource a -> IO (BufferData b)
    createBufferData src = case src of
       File filePath -> withCString filePath $ \fp -> loadWith (alut_LoadMemoryFromFile fp)
       FileImage (MemoryRegion buf size) -> loadWith (alut_LoadMemoryFromFileImage buf size)
       HelloWorld -> loadWith alut_LoadMemoryHelloWorld
       Sine f p d -> loadWith (alut_LoadMemoryWaveform alut_WAVEFORM_SINE f p d)
       Square f p d -> loadWith (alut_LoadMemoryWaveform alut_WAVEFORM_SQUARE f p d)
       Sawtooth f p d -> loadWith (alut_LoadMemoryWaveform alut_WAVEFORM_SAWTOOTH f p d)
       Impulse f p d -> loadWith (alut_LoadMemoryWaveform alut_WAVEFORM_IMPULSE f p d)
       WhiteNoise d -> loadWith (alut_LoadMemoryWaveform alut_WAVEFORM_WHITENOISE 1 0 d)

    loadWith :: (Ptr ALenum -> Ptr ALsizei -> Ptr ALfloat -> IO (Ptr b)) -> IO (BufferData b)
    loadWith loader =
       alloca $ \formatBuf ->
          alloca $ \sizeBuf ->
             alloca $ \frequencyBuf -> do
                buf <- throwIfNullPtr "createBufferData" $
                          loader formatBuf sizeBuf frequencyBuf
                format <- peek formatBuf
                size <- peek sizeBuf
                frequency <- peek frequencyBuf
                return $ BufferData (MemoryRegion buf size) (unmarshalFormat format) frequency

    --------------------------------------------------------------------------------

    bufferMIMETypes :: GettableStateVar [String]
    bufferMIMETypes = mimeTypes "bufferMIMETypes" alut_LOADER_BUFFER

    bufferDataMIMETypes :: GettableStateVar [String]
    bufferDataMIMETypes = mimeTypes "bufferDataMIMETypes" alut_LOADER_MEMORY

    mimeTypes :: String -> ALenum -> GettableStateVar [String]
    mimeTypes name loaderType =
       makeGettableStateVar $ do
          ts <- throwIfNullPtr name $ alut_GetMIMETypes loaderType
          fmap (splitBy (== ',')) $ peekCString ts

    splitBy :: (a -> Bool) -> [a] -> [[a]]
    splitBy _ [] = []
    splitBy p xs = case break p xs of
                    (ys, []  ) -> [ys]
                    (ys, _:zs) -> ys : splitBy p zs