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

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

import Foreign.C.String ( CString, peekCString, withCString )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Storable ( Storable(peek) )
import Foreign.Ptr ( Ptr )
import Graphics.Rendering.OpenGL.GL.StateVar (
   GettableStateVar, makeGettableStateVar )
import Sound.ALUT.Constants ( alut_LOADER_BUFFER, alut_LOADER_MEMORY )
import Sound.ALUT.Errors ( makeBuffer, throwIfNullPtr )
import Sound.OpenAL.AL.BasicTypes ( ALuint, ALsizei, ALenum, ALfloat )
import Sound.OpenAL.AL.Buffer ( Buffer, MemoryRegion(..), BufferData(..) )
import Sound.OpenAL.AL.Format ( unmarshalFormat )
import System.IO ( FilePath )

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

data SoundDataSource a =
     File FilePath
   | FileImage (MemoryRegion a)
#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 alutCreateBufferFromFile
         FileImage (MemoryRegion buf size) -> alutCreateBufferFromFileImage buf size

foreign import CALLCONV unsafe "alutCreateBufferFromFile"
   alutCreateBufferFromFile :: CString -> IO ALuint

foreign import CALLCONV unsafe "alutCreateBufferFromFileImage"
   alutCreateBufferFromFileImage :: Ptr a -> ALsizei -> IO ALuint

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

createBufferData :: SoundDataSource a -> IO (BufferData b)
createBufferData src = case src of
   File filePath ->
      withCString filePath $ \fp -> loadWith (alutLoadMemoryFromFile fp)
   FileImage (MemoryRegion buf size) ->
      loadWith (alutLoadMemoryFromFileImage buf size)

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

foreign import CALLCONV unsafe "alutLoadMemoryFromFile"
   alutLoadMemoryFromFile :: CString -> Ptr ALenum -> Ptr ALsizei -> Ptr ALfloat -> IO (Ptr b)

foreign import CALLCONV unsafe "alutLoadMemoryFromFileImage"
   alutLoadMemoryFromFileImage :: Ptr a -> ALsizei -> Ptr ALenum -> Ptr ALsizei -> Ptr ALfloat -> IO (Ptr b)

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

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 $ alutGetMIMETypes 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

foreign import CALLCONV unsafe "alutGetMIMETypes"
   alutGetMIMETypes :: ALenum -> IO CString
