HSoundFile (empty) → 0.2.2
raw patch · 8 files changed
+720/−0 lines, 8 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, filepath, haskell98, mtl, parallel
Files
- Examples/ex1.lhs +87/−0
- HSoundFile.cabal +35/−0
- LICENSE +25/−0
- README +16/−0
- Setup.lhs +4/−0
- src/Sound/Base.hs +150/−0
- src/Sound/Codecs/WaveFile.hs +331/−0
- src/Sound/File.hs +72/−0
+ Examples/ex1.lhs view
@@ -0,0 +1,87 @@+A simple example showing usage of hsoundfile and AudioMonad.++> module Main where++> import Prelude+> import qualified Sound.File as SF+> import qualified Data.ByteString.Lazy as L+> import qualified Sound.Codecs.WaveFile as WF+> import qualified Control.Monad.Error as Err+> import Data.Binary (encode, decode)+> import System.Environment+> import Data.List (foldl', transpose)+> import Control.Monad.State (execState, evalState)++> main = do myArgs <- getArgs++This program takes two arguments - the name of an input file and the name of an output file.++> let (fName: outName: xs) = myArgs++First open the file as a bytestring, then calculate the peak value within it.+Err.runErrorT strips the AudioMonad (which is just a Control.Monad.ErrorT) from the +computation, leaving just an IO (Either AudioError SF.SoundData), which is ignored++> bs <- L.readFile fName+> Err.runErrorT $ getMax bs++We're re-opening the file to re-process it. This is to allow the GC to collect the [SoundFrame]+produced within the getMax function. If we reference the same SndFileCls instance, the entire +[SoundFrame] will stay in memory. For small files this isn't an issue, but with large files+it can induce thrashing, so it's good practice to re-read the file for each operation (on the audio data).+Some knowledge of laziness is required to know when this will help and when it doesn't matter.++> bs' <- L.readFile fName+> r <- Err.runErrorT $ rewrite bs outName++Here, we process the result of runErrorT. If there was some problem with reading the file, it will+be reported.++> case r of+> Right _ -> print "Done"+> Left err -> print . show $ err+++getMax calculates the maximum value within an AudioMonad++> getMax :: L.ByteString -> SF.AudioMonad IO SF.SoundData+> getMax bs = do++First, decode the ByteString to a SndFileCls instance using SF.decodeSoundFileBS+We pattern match the output of this function in order to have easy access to the sfInfo+in order to display it++> sf@(SF.SoundFile sfInfo sfData) <- SF.decodeSoundFileBS bs++print the header information++> Err.liftIO $ print sfInfo++decode the audio data from the sound file and calculate the peak amplitude within it.++> as <- SF.getAudioData sf+> let maxamp = findMaxAmplitude as++display the length of the file (in frames) and the peak amplitude.++> Err.liftIO $ print $ (++) "frames of data: " $ show $ SF.lengthInFrames sfData+> Err.liftIO $ print $ (++) "Max amplitude is: " $ show maxamp+> return maxamp++> findMaxAmplitude :: SF.AudioSig -> SF.SoundData+> findMaxAmplitude asig = foldl' (foldl' (max . abs)) 0 . SF.audioData $ asig++rewrite takes an input ByteString and copies the soundfile to the output filename+Although the ByteString could just be copied directly, +I am forcing the conversion to demonstrate the functions, as well as test the performance+of the codec. At this time, metadata (Author, title, etc.) within the wave file is lost+upon conversion, since it's not referenced within the SndFileCls class.++> rewrite :: L.ByteString -> String -> SF.AudioMonad IO ()+> rewrite inBs o = do+> sf@(SF.SoundFile sfInfo sfData) <- SF.decodeSoundFileBS inBs+> oF <- SF.toWaveFile sf+> Err.liftIO $ L.writeFile o . encode $ oF+++
+ HSoundFile.cabal view
@@ -0,0 +1,35 @@+Name: HSoundFile+Version: 0.2.2+Cabal-Version: >= 1.2+Description: encode and decode soundfiles using lazy ByteStrings.+ Audio files may be read or written, with classes and + data structures to facilitate conversion between different+ formats. Currently only wave format is supported.+ Error handling is supported via Control.Monad.ErrorT.+License: BSD3+License-file: LICENSE+Author: John W. Lato, jwlato@gmail.com+Maintainer: John W. Lato, jwlato@gmail.com+homepage: http://mml.music.utexas.edu/jwlato/HSoundFile+Stability: experimental+synopsis: Audio file reading/writing+category: Codecs, Sound+build-type: Simple+cabal-version: >= 1.2+tested-with: GHC == 6.8.2, GHC == 6.8.1, GHC == 6.6.1+extra-source-files: README, Examples/ex1.lhs++flag splitBase+ description: Choose the new split-up base package.++Library+ Hs-Source-Dirs: src+ ghc-options: -O2 -Wall -fexcess-precision+ if flag(splitBase)+ build-depends: base >= 3, bytestring >= 0.9+ else+ build-depends: base < 3+ build-depends: haskell98, binary, filepath, mtl, parallel+ exposed-modules: Sound.File,+ Sound.Base,+ Sound.Codecs.WaveFile
+ LICENSE view
@@ -0,0 +1,25 @@+BSD 3+* Copyright (c) 2007, John W. Lato+* All rights reserved.+*+* Redistribution and use in source and binary forms, with or without+* modification, are permitted provided that the following conditions are met:+* * Redistributions of source code must retain the above copyright+* notice, this list of conditions and the following disclaimer.+* * Redistributions in binary form must reproduce the above copyright+* notice, this list of conditions and the following disclaimer in the+* documentation and/or other materials provided with the distribution.+* * Neither the name of Tiresias Press nor the+* names of its contributors may be used to endorse or promote products+* derived from this software without specific prior written permission.+*+* THIS SOFTWARE IS PROVIDED BY John W. Lato ``AS IS'' AND ANY+* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+* DISCLAIMED. IN NO EVENT SHALL John W. Lato BE LIABLE FOR ANY+* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,16 @@+HSoundFile - codecs for audio file reading/writing++This library is based on Data.ByteString and Data.Binary to support lazy reading/writing+of audio files.++Requirements: GHC > 6.6. Other compilers are not currently supported due to a dependency on GHC's Float/Double library.++Building:+ > runhaskell Setup.lhs configure+ > runhaskell Setup.lhs build+ > runhaskell Setup.lhs install++I have achieved best performance with the following compiler options:+-fvia-c -fexcess-precision -optc-O2 -optc-mmmx -optc-msse2+If possible, I recommend enabling mmx and sse2.+
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ src/Sound/Base.hs view
@@ -0,0 +1,150 @@+-- |Datatypes and functions useful for all SoundFile datatypes.+module Sound.Base (+ -- * Basic Audio data types+ SampleRate,+ BitDepth,+ SoundData,+ SoundFrame,+ FrameCount,+ AudioSig,+ -- ** SoundFile types and classes+ SndFileInfo ( .. ),+ SndFileType ( .. ),+ SoundFile ( SoundFile ),+ SndFileCls (getSfInfo, getSfType, fromSndFileCls, getAudioData, getAudioLength),+ -- * Error handling+ AudioError (..),+ AudioMonad,+ -- * Functions+ -- ** SoundFile functions+ lengthInFrames,+ audioData,+ makeFrames,+ interleave,+ -- ** AudioSig functions+ makeAudioSignal,+ appendASig,+ concatASig+ ) where++import Data.List (transpose)+import Control.Parallel.Strategies (rnf, (>|))+import qualified Control.Parallel.Strategies as Strat+import qualified Control.Monad.Error as Err++-- |The samplerate value, in samples per second.+type SampleRate = Integer++-- |The bit depth, or word length, of audio data.+type BitDepth = Integer++-- |A single sample of audio data. Represented normalized to [-1,1]+type SoundData = Double++-- |One frame of audio data, i.e. the sample value for each channel in the data.+type SoundFrame = [SoundData]++-- |A position in a data stream, or a length, in frame values.+type FrameCount = Integer++-- |An audio data stream. This has both the raw audio data (as a list of 'SoundFrame'),+-- and the total length, in frames.+data AudioSig = AudioSig {+ -- | The audio data.+ audioData :: [SoundFrame],+ -- | length of the audio data.+ lengthInFrames :: FrameCount+ } deriving (Eq, Show)+-- The total length needs to be passed as well so+-- it can be written without forcing all the elements in the list. This is a bit of a +-- hack, but I want to see how workable it is. I've also tried it as a monad, which was less successful.+-- however, perhaps it should be a tuple. The audioData won't be forced because it's a list, I think...+++makeAudioSignal :: FrameCount -> [SoundFrame] -> AudioSig+makeAudioSignal fc frames = AudioSig frames fc++appendASig :: AudioSig -> AudioSig -> AudioSig+appendASig a b = AudioSig (concat [audioData a, audioData b]) $ (lengthInFrames a) + (lengthInFrames b)++concatASig :: [AudioSig] -> AudioSig+concatASig a = AudioSig (concat . map audioData $ a) (sum . map lengthInFrames $ a)++{-|Monad to support error handling.+-}+type AudioMonad m = Err.ErrorT AudioError m++data AudioError = NoFormatError -- ^ Audio format information not found in file+ | UnknownFileTypeError -- ^ File is not in a recognized file format+ | InvalidBitDepthError BitDepth [BitDepth] -- ^ Specified bit depth is not supported+ | OtherError String -- ^ unspecified error.++instance Err.Error AudioError where+ noMsg = OtherError "An Audio Error!"+ strMsg s = OtherError s++instance Show AudioError where+ show (NoFormatError) = "No format information found."+ show UnknownFileTypeError = "The file does not appear to be a recognized audio file."+ show (InvalidBitDepthError r vs) = "Requested bit depth " ++ show r ++ " is invalid. Valid bit depths are " ++ show vs+ show (OtherError s) = s++{-|The basic class datatypes that represent soundfiles should support.+-}+class SndFileCls a where+ -- | get a 'SndFileInfo' with data for the current SoundFile + getSfInfo :: (Monad m) => a -> AudioMonad m SndFileInfo+ -- | get the type of the underlying instance + getSfType :: a -> SndFileType --WavePCM, AIFF, etc+ -- | Get the AudioSig from the SndFileCls instance.+ getAudioData :: (Monad m) => a -> AudioMonad m AudioSig+ -- | convert a SndFileCls instance to the SoundFile type.+ fromSndFileCls :: (Monad m) => a -> AudioMonad m SoundFile+ fromSndFileCls sf = do+ sfi <- getSfInfo sf+ ad <- getAudioData sf+ return $ SoundFile sfi ad+ -- | Get the length of audio data, in frames.+ getAudioLength :: (Monad m) => a -> AudioMonad m FrameCount+ getAudioLength a= do+ ad <- getAudioData a+ return $ lengthInFrames ad++-- | Basic information about the audio data: number of channels, samplerate, and bit depth.+data SndFileInfo = SndFileInfo {numChannels :: Int, sr :: SampleRate,+ bitDepth :: BitDepth} deriving (Eq, Show)++instance Strat.NFData SndFileInfo where+ rnf (SndFileInfo chn sr' bd) = rnf chn >| rnf sr' >| rnf bd++{-|The type of the 'SndFileCls'+ Internal is a special type used for the 'SndFile' class.+-}+data SndFileType =+ AIFF+ | WavePCM+ | OtherSoundFile String+ | Internal deriving (Eq, Show) --more to be added as I have time. AIFF not impl.++-- |A generic datatype for SoundFile data.+data SoundFile = SoundFile { sfFileInfo :: SndFileInfo,+ sfFileData :: AudioSig }+instance SndFileCls SoundFile where + getSfInfo = return . sfFileInfo + getAudioData = return . sfFileData + getSfType _ = Internal+instance Eq SoundFile where+ a == b = sfFileInfo a == sfFileInfo b+instance Show SoundFile where+ show = show . sfFileInfo++-- |Convert an interleaved ['SoundData'] (e.g., [l1, r1, l2, r2,...]) to ['SoundFrame']+makeFrames :: Int -> [SoundData] -> [SoundFrame]+makeFrames _ [] = []+makeFrames 1 xs = map (:[]) xs+makeFrames numChans xs = frames : makeFrames numChans rest+ where (frames, rest) = splitAt numChans xs++-- |Interleave a [['SoundData']] to ['SoundFrame'], e.g. [[l1,l2,l3], [r1,r2,r3]] -> [[l1,r1], [l2,r2], [l3, r3]]+interleave :: [[SoundData]] -> [SoundFrame]+interleave = transpose
+ src/Sound/Codecs/WaveFile.hs view
@@ -0,0 +1,331 @@+{-# LANGUAGE CPP #-}++{-|+ Encode lazy bytestrings to wave format, and decode lazy bytestrings in wave format to a WaveFile datum.+-}+module Sound.Codecs.WaveFile (+ -- * Constructors+ WaveFile (WaveFile),+ WaveChunk ( .. ),+ -- * Encode\/decode functions+ getWaveFile,+ toWaveFile,+ isWaveFile+ ) where++import Data.Int+import Data.Word++#if defined(__GLASGOW_HASKELL__)+import GHC.Float ( double2Int )+#endif++import Data.Bits (shiftR, shiftL, (.&.), (.|.))+import Data.Binary (Binary, Get, Put, get, put, decode)+import qualified Data.Binary.Put as BP+import qualified Data.Binary.Get as BG++import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as C++import qualified Control.Monad as CM+import qualified Control.Monad.State as St+import qualified Control.Monad.Error as Err++import Data.List (foldl', unfoldr)+import Sound.Base++--constants used in the file+riffBS :: L.ByteString+riffBS = id $! C.pack "RIFF"++waveBS :: L.ByteString+waveBS = id $! C.pack "WAVE"++dataBS :: L.ByteString+dataBS = id $! C.pack "data"++fmtBS :: L.ByteString+fmtBS = id $! C.pack "fmt " --space is part of the fmt string++metaBS :: L.ByteString+metaBS = id $! C.pack "LIST"+--end constants++-- |A SubChunk of a Wave file.+data WaveChunk = WaveFormat { format :: SndFileInfo }+ -- ^Format of the audio data.+ | WaveData { waveData :: L.ByteString, chunkLength :: Integer }+ -- ^The audio data+ | WaveMeta { metaData :: L.ByteString, chunkLength :: Integer }+ -- ^Any metadata in the file.+ | UnknownWaveChunk { chunkType :: L.ByteString,+ unparsedData :: L.ByteString,+ chunkLength :: Integer }+ -- ^an unknown chunk type+ deriving (Show, Eq)+ --chunkLength can be a maximum of Word32 length, but that's an inconvenient type to use.+ --if using signed ints, must use Int64 for the same range, but for common cases Int64 is likely+ --less efficient than a plain Integer++instance Binary WaveChunk where+ get = do fmtChunk <- BG.getLazyByteString 4+ case (C.unpack fmtChunk) of+ "data" -> do+ size <- BG.getWord32le+ dString <- BG.getLazyByteString $ fromIntegral size+ return $ WaveData dString (fromIntegral size)+ "fmt " -> do+ --chunkLen <- BG.getWord32le+ BG.getWord32le --don't need the length+ fType <- BG.getWord16le+ if (fType == 1)+ then do+ chns <- BG.getWord16le+ sR <- BG.getWord32le+ BG.skip 4 --byterate+ BG.skip 2 --alignment+ bDepth <- BG.getWord16le+ return $ WaveFormat (SndFileInfo (fromIntegral chns) (fromIntegral sR) (fromIntegral bDepth))+ else+ fail ("Can't read non-PCM Wave chunk. Type = " ++ show fType)+ "LIST" -> do+ chunkLen <- BG.getWord32le+ dString <- BG.getLazyByteString $ fromIntegral chunkLen+ return $ WaveMeta dString (fromIntegral chunkLen)+ _ -> do --unknown chunk type+ chunkLen <- BG.getWord32le+ dString <- BG.getLazyByteString $ fromIntegral chunkLen+ return $ UnknownWaveChunk fmtChunk dString $ fromIntegral chunkLen++ put (WaveData dBs chunkLen) =+ do BP.putLazyByteString dataBS+ BP.putWord32le $ fromIntegral chunkLen+ BP.putLazyByteString dBs+ put (WaveFormat (SndFileInfo numChn sR bDepth)) =+ do BP.putLazyByteString fmtBS+ BP.putWord32le 16 --length of format chunk+ BP.putWord16le 1 -- format type (1 for PCM)+ BP.putWord16le $ fromIntegral numChn+ BP.putWord32le $ fromIntegral sR+ BP.putWord32le $ fromIntegral dataRate+ BP.putWord16le $ fromIntegral align+ BP.putWord16le $ fromIntegral bDepth+ where+ align = (fromIntegral numBytes) * numChn+ dataRate = ((fromIntegral sR) * align)+ numBytes = bDepth `div` 8+ put (WaveMeta dBs chunkLen) = + do BP.putLazyByteString metaBS+ BP.putWord32le $ fromIntegral chunkLen+ BP.putLazyByteString dBs+ put (UnknownWaveChunk ct dBs chunkLen) =+ BP.putLazyByteString ct >> (BP.putWord32le $ fromIntegral chunkLen) >> BP.putLazyByteString dBs++getChunkLength :: WaveChunk -> Integer+getChunkLength (WaveFormat _) = 16+getChunkLength a = chunkLength a++newtype WaveFile = WaveFile [WaveChunk] deriving (Show, Eq)++instance Binary WaveFile where+ get = do+ riffPart <- BG.getLazyByteString 4+ restLen <- BG.getWord32le+ wvPart <- BG.getLazyByteString 4+ case ((C.unpack riffPart) ++ (C.unpack wvPart)) of+ "RIFFWAVE" -> do+ lbs <- BG.getLazyByteString $ (-) (fromIntegral restLen) 4+ return $ WaveFile $ map decode . unroll $ lbs+ _ -> fail "Not a RIFF/Wave file"+ put (WaveFile chunks) = do+ BP.putLazyByteString riffBS+ BP.putWord32le $ fromIntegral totalLen+ BP.putLazyByteString waveBS+ mapM_ put chunks+ where totalLen = (+) 4 $ foldl' (+) 0 $ map (\x -> 8 + getChunkLength x) chunks++instance SndFileCls WaveFile where+ getSfInfo (WaveFile cs) = case (St.execState (mapM_ processChunk cs) Nothing) of+ Just sf -> return sf+ Nothing -> Err.throwError NoFormatError + getAudioData (WaveFile cs) = return $ concatASig $ St.evalState (mapM processChunk cs) Nothing+ getSfType _ = WavePCM++type WaveFileReader a = St.State (Maybe SndFileInfo) a++processChunk :: WaveChunk -> WaveFileReader AudioSig+processChunk (WaveFormat f) = do+ St.put $ Just f+ return $ makeAudioSignal 0 []+processChunk c@(WaveData _ _) = do+ mf <- St.get+ case mf of+ Just f -> return $ makeAudioSignal (cLenInFrames f c) (makeFrames (numChannels f) . decodeSoundData f $ c)+ Nothing -> fail "No format chunk found in Wave file."+processChunk _ = return $ makeAudioSignal 0 []++cLenInFrames :: SndFileInfo -> WaveChunk -> FrameCount+cLenInFrames sf (WaveData _ chunkLen) = chunkLen `div` divisor+ where divisor = (*) (fromIntegral $ div (bitDepth sf) 8) (fromIntegral $ numChannels sf)+cLenInFrames _ _ = 0++-- encoders and decoders for the wave data chunk++-- |Read a WaveData WaveChunk into a list of SoundData+decodeSoundData :: SndFileInfo -> WaveChunk -> [SoundData]+decodeSoundData sfInfo (WaveData theDataBS chunkLen) =+ BG.runGet readGet theDataBS+ where+ bitVal = bitDepth sfInfo+ readGet = case (bitVal) of+ 8 -> CM.replicateM (fromIntegral chunkLen) . mapFn $ getSD8+ 16 -> CM.replicateM (fromIntegral $ div chunkLen 2) . mapFn $ getSD16+ 24 -> CM.replicateM (fromIntegral $ div chunkLen 3) . mapFn $ getSD24+ 32 -> CM.replicateM (fromIntegral $ div chunkLen 4) . mapFn $ getSD32+ a -> fail ("Can't read " ++ (show a) ++ "-bit audio.")+ mapFn :: (Functor m, Monad m, Integral a) => m (a) -> m (SoundData)+ mapFn = fmap (normalize bitVal)+decodeSoundData _ _ = [] --can't read data from a non-data chunk++{-|+ Functions to normalize newly-read data+ I believe this function is correctly implemented.+-}+normalize :: Integral a => BitDepth -> a -> SoundData+normalize 8 a = ((fromIntegral a - 128)) / 128+normalize _ 0 = 0+normalize bd a = case (a > 0) of+ True -> (fromIntegral a) / divPos+ False -> (fromIntegral a) / divNeg+ where+ divPos = (fromIntegral (1 `shiftL` fromIntegral (bd - 1) :: Int)) - 1+ divNeg = fromIntegral (1 `shiftL` fromIntegral (bd - 1) :: Int)++getSD8 :: Get (Int8)+getSD8 = CM.liftM fromIntegral BG.getWord8+ +getSD16 :: Get (Int16)+getSD16 = CM.liftM fromIntegral BG.getWord16le++getSD24 :: Get (Int32)+getSD24 = do ab <- BG.getWord16le+ c <- BG.getWord8+ let m::Int32+ m = shiftR (shiftL (fromIntegral c) 24) 8+ return $! m .|. (fromIntegral ab)++getSD32 :: Get (Int32)+getSD32 = CM.liftM fromIntegral BG.getWord32le++-- |Create a WaveData wavechunk from a SndFileInfo and an AudioSig+encodeSoundData :: (Monad m) => SndFileInfo -> AudioSig -> AudioMonad m WaveChunk+encodeSoundData sfInfo asig = do+ p <- sdPut+ let bs = case (fList) of+ [] -> L.empty+ _ -> BP.runPut p+ return $ WaveData bs chunkLen+ where+ frameLen = lengthInFrames asig+ fList = audioData asig+ bitVal = bitDepth sfInfo+ chunkLen = (fromIntegral frameLen) * (div (fromIntegral bitVal) 8) * (fromIntegral $ numChannels sfInfo)+ sdPut :: (Monad m) => AudioMonad m (BP.PutM ())+ sdPut = case (bitVal) of+ 8 -> return $ mapM_ (putSD8 . fromIntegral . unNormalize 8) . concat $ fList+ 16 -> return $ mapM_ (putSD16 . fromIntegral . unNormalize 16) . concat $ fList+ 24 -> return $ mapM_ (putSD24 . fromIntegral . unNormalize 24) . concat $ fList+ 32 -> return $ mapM_ (putSD32 . fromIntegral . unNormalize 32) . concat $ fList+ x -> Err.throwError $ InvalidBitDepthError x [8,16,24,32]++-- |Un-normalize data, convert to the format native type.+unNormalize :: BitDepth -> SoundData -> Int+unNormalize 8 a = GHC.Float.double2Int (128 * (1+a))+unNormalize bd a = let+ posMult = fromIntegral $ ((1 `shiftL` (fromIntegral bd - 1)) :: Integer) - 1+ negMult = fromIntegral (1 `shiftL` (fromIntegral bd - 1) :: Integer)+ in+ case (a >= 0) of+ True -> fastRound (posMult * clip a)+ False -> fastRound (negMult * clip a)++#if defined(__GLASGOW_HASKELL__)+fastRound :: SoundData -> Int+fastRound x = case (x >= 0 ) of+ True -> GHC.Float.double2Int (x + 0.5)+ False -> GHC.Float.double2Int (x - 0.5)+#else+-- don't know how to optimize this for other compilers+fastRound :: SoundData -> Int+fastRound = round+#endif++putSD8 :: Word8 -> Put+putSD8 = BP.putWord8++-- this is the biggest bottleneck; there isn't much I can do about that.+putSD16 :: Word16 -> Put+putSD16 = BP.putWord16le++-- Since Word24 isn't a data type, we need to fake one from a 32-bit value+-- like the other put functions, this one is little-endian.+putSD24 :: Word32 -> Put+putSD24 val = do+ BP.putWord8 . fromIntegral $ (.&.) val mask+ BP.putWord8 . fromIntegral $ shiftR ((.&.) val m2) 8+ BP.putWord8 . fromIntegral $ shiftR ((.&.) val m3) 16+ where+ mask::Word32+ mask = 0xFF+ m2 = shiftL mask 8+ m3 = shiftL mask 16++putSD32 :: Word32 -> Put+putSD32 = BP.putWord32le++-- |Clip a SoundData to range [-1,1] for writing out.+clip :: SoundData -> SoundData+clip = max (-1) . min 1+{-# INLINE clip #-}+--end encoders and decoders.+++-- |Convert a L.ByteString into a list of ByteStrings, corresponding to WaveChunks.+-- used in binary instance.+unroll :: L.ByteString -> [L.ByteString]+unroll = unfoldr unroll'++unroll' :: L.ByteString -> Maybe (L.ByteString, L.ByteString)+unroll' bs+ | (bs == L.empty) = Nothing+ | otherwise = case (first == L.empty) of+ True -> Nothing+ False -> Just (first, next)+ where+ (first, next) = L.splitAt chunkLen bs+ getLen = do BG.skip 4+ val <- BG.getWord32le+ return val+ chunkLen = 8 + (fromIntegral $ BG.runGet getLen bs)+--end unroll++-- |Create a WaveFile from a SndFileCls+toWaveFile :: (SndFileCls a, Monad m) => a -> AudioMonad m WaveFile+toWaveFile sfc = do+ sf <- getSfInfo sfc+ d <- getAudioData sfc+ cs <- encodeSoundData sf d+ return $ WaveFile $ (WaveFormat sf):cs:[]++-- |return a WaveFile from a bytestring (including header)+getWaveFile :: (Monad m) => L.ByteString -> AudioMonad m (WaveFile)+getWaveFile bs+ | (isWaveFile . L.take 12 $ bs) = return $ decode bs+ | otherwise = Err.throwError $ UnknownFileTypeError++-- |determine (based on header information) if the bytestring is a wave file.+isWaveFile :: L.ByteString -> Bool+isWaveFile bs+ | (L.take 4 bs == riffBS) && ((L.drop 8 . L.take 12 $ bs) == waveBS) = True+ | otherwise = False
+ src/Sound/File.hs view
@@ -0,0 +1,72 @@+{-|+ Enable reading and writing of SoundFiles. This module defines several datatypes for multiple audio file formats.+ Each datatype is an instance of Data.Binary, enabling lazy conversion to and from Lazy Bytestrings using the+ decodeSoundFileBS function. The different soundfile datatypes are generally not used directly, but+ are converted to the generic SoundFile type.+-}+module Sound.File (+ module Sound.Base,+ -- * Generic functions+ decodeSoundFileBS,+ decodeSoundFileHinted,+ getType,+ getTypeFromName,+ -- * Format-specific functions+ -- ** Wave format+ WF.toWaveFile+ ) where++import Char (toUpper)+import qualified System.FilePath as FP++import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy (ByteString)+import Data.Binary (decode)+import qualified Control.Monad.Error as Err++import Sound.Base+import Sound.Codecs.WaveFile (isWaveFile, WaveFile)+import qualified Sound.Codecs.WaveFile as WF+++-- |Decode a Lazy ByteString to a SoundFile. This should be used instead of Data.Binary decode+-- to make sure that the correct file format is used.+decodeSoundFileBS :: Monad m => ByteString -> AudioMonad m SoundFile+decodeSoundFileBS bs = do+ t <- getType bs+ case t of+ WavePCM -> fromSndFileCls (decode bs :: WaveFile)+ _ -> Err.throwError UnknownFileTypeError++-- |Attempt to decode a soundfile as the specified type. Return Nothing on failure.+-- This function may be faster than using decodeSoundFileBS if the type is known.+decodeSoundFileHinted :: Monad m => SndFileType -> ByteString -> AudioMonad m SoundFile+decodeSoundFileHinted hintSf bs = case hintSf of+ WavePCM -> fromSndFileCls (decode bs :: WaveFile)+ _ -> decodeSoundFileBS bs++-- |Find the SndFileType of a ByteString.+-- This function assumes that at most the file will match one format. If more than one format matches,+-- the first found will be the format used.+getType :: Monad m => ByteString -> AudioMonad m SndFileType+getType bs = case (theNum) of+ 1 -> return WavePCM+ _ -> Err.throwError UnknownFileTypeError+ where+ wave :: (Integer, Bool)+ wave = (1, isWaveFile bs)+ matchList = filter (\(_,y) -> y) $ [wave]+ (theNum, _) = head matchList++{-|Attempt to guess the SndFileType from the extension of the file.+This does not check that the file actually is valid data.+-}+getTypeFromName :: (Monad m) => FP.FilePath -> AudioMonad m SndFileType+getTypeFromName fName = case (map toUpper (FP.takeExtension fName)) of+ "WAV" -> return WavePCM+ "WAVE" -> return WavePCM+ "AIF" -> return AIFF+ "AIFF" -> return AIFF+ _ -> Err.throwError UnknownFileTypeError++