libmad and os/x coreaudio wrappers

Hi there! I've taken my first stab at writing some (admittedly minimal) libraries for Haskell, and would love to get feedback on them: * hmad: a wrapper for the libmad MP3 decoder. http://maubi.net/~waterson/REPO/hmad * CoreAudio: a wrapper for OS/X CoreAudio. http://maubi.net/~waterson/REPO/CoreAudio (You should be able to "darcs get" the above links, if you want.) I wrote the libmad wrapper to generate a "stream" (i.e., a lazy list) of audio samples. CoreAudio allows the input stream to be lazy, as well. So, here's a simple MP3 player:
module Main where
import Sound.CoreAudio import Codec.Audio.MP3.Mad import qualified Data.ByteString.Lazy as B import System import System.IO
main :: IO () main = do files <- getArgs mapM_ playFile files
playFile :: String -> IO () playFile file = withBinaryFile file ReadMode $ \ inHandle -> do xs <- B.hGetContents inHandle samples <- decode xs play samples
I do have a couple questions... * The CoreAudio library requires its users to be compiled with "-threaded". Is there a way to specify that in the Cabal file? * I wanted to be able to generate a variety of streams from libmad. Besides stereo linear PCM data, it also seemed like it might be worth-while to produce a stream of MP3 frame headers, the unsynthesized frequency domain data, and so on. I tried to accomplish this with a the DecoderSink class, but I'm not sure I succeeded. Any thoughts here would be appreciated! I hope someone else finds these useful. The FFI was a joy to use once I figured it out... :) chris

On 2008.03.19 11:09:00 -0700, Chris Waterson
Hi there! I've taken my first stab at writing some (admittedly minimal) libraries for Haskell, and would love to get feedback on them:
* hmad: a wrapper for the libmad MP3 decoder. http://maubi.net/~waterson/REPO/hmad
* CoreAudio: a wrapper for OS/X CoreAudio. http://maubi.net/~waterson/REPO/CoreAudio
(You should be able to "darcs get" the above links, if you want.)
I wrote the libmad wrapper to generate a "stream" (i.e., a lazy list) of audio samples. CoreAudio allows the input stream to be lazy, as well. So, here's a simple MP3 player:
module Main where
import Sound.CoreAudio import Codec.Audio.MP3.Mad import qualified Data.ByteString.Lazy as B import System import System.IO
main :: IO () main = do files <- getArgs mapM_ playFile files
playFile :: String -> IO () playFile file = withBinaryFile file ReadMode $ \ inHandle -> do xs <- B.hGetContents inHandle samples <- decode xs play samples
I do have a couple questions...
* The CoreAudio library requires its users to be compiled with "-threaded". Is there a way to specify that in the Cabal file?
I don't think so. Actually, I asked dcoutts, and he said Cabal cannot make a user use a specified ghc-option:. Apparently it did once, but it was abused and got removed: "The only problem is that threaded applies to the final program. If a library declares that it needs threaded, does that mean we have to propagate the flag and use it with all programs that use it? Propagating GHC flags is not possible currently - by design. GHC used to have such a feature and it was removed. Or perhaps we say it's an extension that only applies to executables?" http://hackage.haskell.org/trac/hackage/ticket/26 ...
chris
-- gwern enigma main Warfare DREC Intiso cards kilderkin Crypto Waihopai Oscor
participants (2)
-
Chris Waterson
-
gwern0@gmail.com