{-# OPTIONS -fglasgow-exts #-} ---------------------------------------------------------------------- -- | -- Module : Codec.Audio.MP3.Mad -- Copyright : (c) Chris Waterson 2008 -- License : BSD3 -- -- Maintainer : waterson@maubi.net -- Stability : experimental -- Portability : platform-specific -- -- This module allows you to play a stream of audio data via the OS/X -- CoreAudio API. The audio stream is evaluated lazily. -- -- > import Sound.CoreAudio -- > main :: IO () -- > main = do play $ zip stream stream -- > where stream = [ 0.75 * sin (2.0 * pi * 440.0 * x / 44100.0) -- > | x <- [1.0..] ] -- -- For more information on CoreAudio, see -- data AudioBuffer = AudioBuffer { mNumberChannels :: Int32 , mDataByteSize :: Int32 , mData :: StorableArray (Int, Int) CFloat } instance Storable AudioBuffer where sizeOf _ = #const sizeof(AudioBuffer) alignment _ = alignment (undefined :: Int32) peek p = do numberChannels <- (#peek AudioBuffer, mNumberChannels) p dataByteSize <- (#peek AudioBuffer, mDataByteSize) p data_ <- (#peek AudioBuffer, mData) p arr_ <- newForeignPtr_ data_ arr <- unsafeForeignPtrToStorableArray arr_ $ makeBounds dataByteSize numberChannels return AudioBuffer { mNumberChannels = numberChannels , mDataByteSize = dataByteSize , mData = arr } where makeBounds bytes channels = let b = fromIntegral bytes c = fromIntegral channels in ((1,1),(c,b `div` (sizeOf x * c))) x :: CFloat = undefined poke _ _ = error "poke: AudioBuffer" data AudioBufferList = AudioBufferList { mNumberBuffers :: Int32 , mBuffer :: AudioBuffer } instance Storable AudioBufferList where sizeOf _ = #const sizeof(AudioBufferList) alignment _ = alignment (undefined :: Int32) peek p = do numberBuffers <- (#peek AudioBufferList, mNumberBuffers) p buffer <- (#peek AudioBufferList, mBuffers) p return AudioBufferList { mNumberBuffers = numberBuffers , mBuffer = buffer } poke _ _ = error "poke: AudioBufferList" foreign import ccall unsafe "AudioHardwareGetProperty" c_AudioHardwareGetProperty :: Int32 -> Ptr Int32 -> Ptr () -> IO () defaultOutputDeviceID :: IO Int32 defaultOutputDeviceID = alloca $ \ audioDeviceID_ -> with x $ \ propertySize_ -> do c_AudioHardwareGetProperty (#const kAudioHardwarePropertyDefaultOutputDevice) propertySize_ (castPtr audioDeviceID_) peek audioDeviceID_ where x :: Int32 = fromIntegral $ sizeOf (undefined :: Int32) ---------------------------------------------------------------------- foreign import ccall unsafe "AudioDeviceGetProperty" c_AudioDeviceGetProperty :: Int32 -- AudioDeviceID inDevice -> Int32 -- UInt32 inChannel -> Int32 -- Boolean isInput -> Int32 -- AudioDevicePropertyID inPropertyID -> Ptr Int32 -- UInt32 *ioPropertyDataSize -> Ptr () -- void *outPropertyData -> IO Int32 foreign import ccall unsafe "AudioDeviceGetPropertyInfo" c_AudioDeviceGetPropertyInfo :: Int32 -- AudioDeviceID inDevice -> Int32 -- UInt32 inChannel -> Int32 -- Boolean isInput -> Int32 -- AudioDevicePropertyID inPropertyID -> Ptr Int32 -- UInt32 *outSize -> Ptr Int32 -- Boolean *outWritable -> IO Int32 data AudioValueRange = AudioValueRange { mMinimum :: Double , mMaximum :: Double } instance Storable AudioValueRange where sizeOf _ = #const sizeof(AudioValueRange) alignment _ = alignment (undefined :: Int32) peek p = do mn <- (#peek AudioValueRange, mMinimum) p mx <- (#peek AudioValueRange, mMaximum) p return $ AudioValueRange { mMinimum = mn, mMaximum = mx } poke _ _ = error "poke: AudioValueRange" getSampleRates :: Int32 -> IO [(Double, Double)] getSampleRates deviceID = alloca $ \ nbytes_ -> do _ <- c_AudioDeviceGetPropertyInfo deviceID 0 0 (#const kAudioDevicePropertyAvailableNominalSampleRates) nbytes_ nullPtr nbytes <- peek nbytes_ allocaBytes (fromIntegral nbytes) $ \ rates_ -> do _ <- c_AudioDeviceGetProperty deviceID 0 0 (#const kAudioDevicePropertyAvailableNominalSampleRates) nbytes_ rates_ avrs :: [AudioValueRange] <- peekArray (fromIntegral nbytes `div` sizeOf avr) (castPtr rates_) return $ map (\ avr' -> (mMinimum avr', mMaximum avr')) avrs where avr = undefined :: AudioValueRange getStreams :: Int32 -> IO [Int32] getStreams deviceID = alloca $ \ nbytes_ -> do _ <- c_AudioDeviceGetPropertyInfo deviceID 0 0 (#const kAudioDevicePropertyStreams) nbytes_ nullPtr nbytes <- peek nbytes_ allocaBytes (fromIntegral nbytes) $ \ streamIDs_ -> do _ <- c_AudioDeviceGetProperty deviceID 0 0 (#const kAudioDevicePropertyStreams) nbytes_ streamIDs_ peekArray (fromIntegral nbytes `div` sizeOf streamID) (castPtr streamIDs_) where streamID = undefined :: Int32 foreign import ccall unsafe "AudioDeviceSetProperty" c_AudioDeviceSetProperty :: Int32 -- AudioDeviceID inDevice -> Ptr () -- const AudioTimeStamp *inWhen -> Int32 -- UInt32 inChannel -> Int32 -- Boolean isInput -> Int32 -- AudioDevicePropertyID inPropertyID -> Int32 -- UInt32 inPropertyDataSize -> Ptr () -- const void *inPropertyData -> IO Int32 setSampleRate :: Int32 -> Double -> IO Int32 setSampleRate deviceID rate = with rate $ \ rate_ -> c_AudioDeviceSetProperty deviceID nullPtr 0 0 (#const kAudioDevicePropertyNominalSampleRate) (fromIntegral $ sizeOf rate) (castPtr rate_) ---------------------------------------------------------------------- data AudioStreamBasicDescription = AudioStreamBasicDescription { mSampleRate :: Double , mFormatID :: Int32 , mFormatFlags :: Int32 , mBytesPerPacket :: Int32 , mFramesPerPacket :: Int32 , mBytesPerFrame :: Int32 , mChannelsPerFrame :: Int32 , mBitsPerChannel :: Int32 , mReserved :: Int32 } instance Storable AudioStreamBasicDescription where sizeOf _ = #const sizeof(AudioStreamBasicDescription) alignment _ = alignment (undefined :: Int32) peek p = do sampleRate <- (#peek AudioStreamBasicDescription, mSampleRate) p formatID <- (#peek AudioStreamBasicDescription, mFormatID) p formatFlags <- (#peek AudioStreamBasicDescription, mFormatFlags) p bytesPerPacket <- (#peek AudioStreamBasicDescription, mBytesPerPacket) p framesPerPacket <- (#peek AudioStreamBasicDescription, mFramesPerPacket) p bytesPerFrame <- (#peek AudioStreamBasicDescription, mBytesPerFrame) p channelsPerFrame <- (#peek AudioStreamBasicDescription, mChannelsPerFrame) p bitsPerChannel <- (#peek AudioStreamBasicDescription, mBitsPerChannel) p reserved <- (#peek AudioStreamBasicDescription, mReserved) p return $ AudioStreamBasicDescription { mSampleRate = sampleRate , mFormatID = formatID , mFormatFlags = formatFlags , mBytesPerPacket = bytesPerPacket , mFramesPerPacket = framesPerPacket , mBytesPerFrame = bytesPerFrame , mChannelsPerFrame = channelsPerFrame , mBitsPerChannel = bitsPerChannel , mReserved = reserved } poke p a = do (#poke AudioStreamBasicDescription, mSampleRate) p (mSampleRate a) (#poke AudioStreamBasicDescription, mFormatID) p (mFormatID a) (#poke AudioStreamBasicDescription, mFormatFlags) p (mFormatFlags a) (#poke AudioStreamBasicDescription, mBytesPerPacket) p (mBytesPerPacket a) (#poke AudioStreamBasicDescription, mFramesPerPacket) p (mFramesPerPacket a) (#poke AudioStreamBasicDescription, mBytesPerFrame) p (mBytesPerFrame a) (#poke AudioStreamBasicDescription, mChannelsPerFrame) p (mChannelsPerFrame a) (#poke AudioStreamBasicDescription, mBitsPerChannel) p (mBitsPerChannel a) (#poke AudioStreamBasicDescription, mReserved) p (mReserved a) foreign import ccall unsafe "AudioStreamGetProperty" c_AudioStreamGetProperty :: Int32 -- AudioStreamID inStream -> Int32 -- UInt32 inChannel -> Int32 -- AudioDevicePropertyID inPropertyID -> Ptr Int32 -- UInt32 *ioPropertyDataSize -> Ptr () -- void *outPropertyData -> IO Int32 foreign import ccall unsafe "AudioStreamGetPropertyInfo" c_AudioStreamGetPropertyInfo :: Int32 -- AudioStreamID inStream -> Int32 -- UInt32 inChannel -> Int32 -- AudioDevicePropertyID inPropertyID -> Ptr Int32 -- UInt32 *outSize -> Ptr Int32 -- Boolean *outWritable -> IO Int32 foreign import ccall unsafe "AudioStreamSetProperty" c_AudioStreamSetProperty :: Int32 -- AudioStreamID inStream -> Ptr () -- const AudioTimeStamp *inWhen -> Int32 -- UInt32 inChannel -> Int32 -- AudioDevicePropertyID inPropertyID -> Int32 -- UInt32 inPropertyDataSize -> Ptr () -- void *inPropertyData -> IO Int32 setStreamSampleRate :: Int32 -> Double -> IO () setStreamSampleRate streamID sampleRate = alloca $ \ (asbd_ :: Ptr AudioStreamBasicDescription) -> with size $ \ size_ -> do _ <- c_AudioStreamGetProperty streamID 0 (#const kAudioStreamPropertyVirtualFormat) size_ (castPtr asbd_) asbd <- peek asbd_ with (asbd { mSampleRate = sampleRate }) $ \ asbd'_ -> do _ <- c_AudioStreamSetProperty streamID nullPtr 0 (#const kAudioStreamPropertyVirtualFormat) size (castPtr asbd'_) return () where size = fromIntegral $ sizeOf (undefined :: AudioStreamBasicDescription) ---------------------------------------------------------------------- data AudioStreamRangedDescription = AudioStreamRangedDescription { mFormat :: AudioStreamBasicDescription , mSampleRateRange :: AudioValueRange } instance Storable AudioStreamRangedDescription where sizeOf _ = #const sizeof(AudioStreamRangedDescription) alignment _ = alignment (undefined :: Int32) peek p = do format <- (#peek AudioStreamRangedDescription, mFormat) p sampleRateRange <- (#peek AudioStreamRangedDescription, mSampleRateRange) p return $ AudioStreamRangedDescription { mFormat = format , mSampleRateRange = sampleRateRange } poke _ _ = error "poke: AudioStreamRangedDescription" getStreamFormats :: Int32 -> IO [AudioStreamRangedDescription] getStreamFormats streamID = alloca $ \ nbytes_ -> do _ <- c_AudioStreamGetPropertyInfo streamID 0 (#const kAudioStreamPropertyAvailableVirtualFormats) nbytes_ nullPtr nbytes <- peek nbytes_ allocaBytes (fromIntegral nbytes) $ \ asrds_ -> do _ <- c_AudioStreamGetProperty streamID 0 (#const kAudioStreamPropertyAvailableVirtualFormats) nbytes_ asrds_ peekArray (fromIntegral nbytes `div` sizeOf asrd) (castPtr asrds_) where asrd = undefined :: AudioStreamRangedDescription ---------------------------------------------------------------------- type AudioDeviceIOProc = Int32 -> Ptr () -> Ptr () -> Ptr () -> Ptr AudioBufferList -> Ptr () -> Ptr () -> IO Int32 foreign import ccall unsafe "AudioDeviceAddIOProc" c_AudioDeviceAddIOProc :: Int32 -> FunPtr(AudioDeviceIOProc) -> Ptr () -> IO Int32 foreign import ccall safe "AudioDeviceStart" c_AudioDeviceStart :: Int32 -> FunPtr(AudioDeviceIOProc) -> IO Int32 foreign import ccall safe "AudioDeviceStop" c_AudioDeviceStop :: Int32 -> FunPtr(AudioDeviceIOProc) -> IO Int32 -- | 'play' @stream@ synchronously plays a stream of stereo, -- floating-point 44.1KHz PCM sample data. The sample data is -- evaluated lazily. play :: [(Float, Float)] -> IO () play samples = do deviceID <- defaultOutputDeviceID _ <- setSampleRate deviceID 44100.0 mvar <- newEmptyMVar sref <- newIORef samples io <- makeAudioIO $ doIO mvar sref _ <- c_AudioDeviceAddIOProc deviceID io nullPtr _ <- c_AudioDeviceStart deviceID io takeMVar mvar _ <- c_AudioDeviceStop deviceID io return () -- | Fills the CoreAudio buffer with data from the stream. doIO :: MVar () -> IORef [(Float, Float)] -> AudioDeviceIOProc doIO mvar sref _ _ _ _ outputData_ _ _ = do outputData <- peek outputData_ ((_,_),(_,n)) <- getBounds $ mData $ mBuffer outputData stream <- readIORef sref case stream of [] -> do putMVar mvar () return 0 _ -> do stream' <- bufferOutputDataFrom stream (mData $ mBuffer outputData) n writeIORef sref stream' return 0 bufferOutputDataFrom :: [(Float, Float)] -> StorableArray (Int, Int) CFloat -> Int -> IO [(Float, Float)] bufferOutputDataFrom stream arr n = withStorableArray arr $ \ e -> do pokeArray e $ foldr (\ (l,r) ss -> (realToFrac l):(realToFrac r):ss) [] samples return samples' where (samples, samples') = splitAt (fromIntegral n) stream foreign import ccall "wrapper" makeAudioIO :: AudioDeviceIOProc -> IO (FunPtr AudioDeviceIOProc)