diff --git a/Examples/ex1.lhs b/Examples/ex1.lhs new file mode 100644 --- /dev/null +++ b/Examples/ex1.lhs @@ -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 + + + diff --git a/HSoundFile.cabal b/HSoundFile.cabal new file mode 100644 --- /dev/null +++ b/HSoundFile.cabal @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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. + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/src/Sound/Base.hs b/src/Sound/Base.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Base.hs @@ -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 diff --git a/src/Sound/Codecs/WaveFile.hs b/src/Sound/Codecs/WaveFile.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Codecs/WaveFile.hs @@ -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 diff --git a/src/Sound/File.hs b/src/Sound/File.hs new file mode 100644 --- /dev/null +++ b/src/Sound/File.hs @@ -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 + +