module Sound.ALUT.Loaders (
Phase, Duration, SoundDataSource(..),
createBuffer, createBufferData,
bufferMIMETypes, bufferDataMIMETypes
) where
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.StateVar ( GettableStateVar, makeGettableStateVar )
import Foreign.C.String ( peekCString, withCString )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Ptr ( Ptr )
import Foreign.Storable ( peek )
import Sound.OpenAL.AL.BasicTypes
import Sound.OpenAL.AL.Buffer ( Buffer, MemoryRegion(..), BufferData(..) )
import Sound.OpenAL.AL.Extensions ( unmarshalFormat )
import Sound.OpenAL.ALC.Context ( Frequency )
import Sound.ALUT.Config
import Sound.ALUT.Constants
import Sound.ALUT.Errors
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
deriving ( Eq, Ord, Show )
createBuffer :: MonadIO m => SoundDataSource a -> m Buffer
createBuffer src = liftIO $ 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 -> createBufferWaveform alut_WAVEFORM_SINE f p d
Square f p d -> createBufferWaveform alut_WAVEFORM_SQUARE f p d
Sawtooth f p d -> createBufferWaveform alut_WAVEFORM_SAWTOOTH f p d
Impulse f p d -> createBufferWaveform alut_WAVEFORM_IMPULSE f p d
WhiteNoise d -> createBufferWaveform alut_WAVEFORM_WHITENOISE 1 0 d
createBufferWaveform :: ALenum -> Float -> Float -> Float -> IO ALuint
createBufferWaveform w f p d =
alut_CreateBufferWaveform w (realToFrac f) (realToFrac p) (realToFrac d)
createBufferData :: MonadIO m => SoundDataSource a -> m (BufferData b)
createBufferData src = liftIO $ 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 (loadMemoryWaveform alut_WAVEFORM_SINE f p d)
Square f p d -> loadWith (loadMemoryWaveform alut_WAVEFORM_SQUARE f p d)
Sawtooth f p d -> loadWith (loadMemoryWaveform alut_WAVEFORM_SAWTOOTH f p d)
Impulse f p d -> loadWith (loadMemoryWaveform alut_WAVEFORM_IMPULSE f p d)
WhiteNoise d -> loadWith (loadMemoryWaveform alut_WAVEFORM_WHITENOISE 1 0 d)
loadMemoryWaveform :: ALenum -> Float -> Float -> Float -> Ptr ALenum -> Ptr ALsizei -> Ptr ALfloat -> IO (Ptr b)
loadMemoryWaveform w f p d =
alut_LoadMemoryWaveform w (realToFrac f) (realToFrac p) (realToFrac 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) (realToFrac 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