WAVE (empty) → 0.1

raw patch · 5 files changed

+428/−0 lines, 5 filesdep +basedep +bytestringsetup-changed

Dependencies added: base, bytestring

Files

• COPYING +34/−0
• Data/WAVE.hs +349/−0
• README +22/−0
• Setup.hs +7/−0
• WAVE.cabal +16/−0

@@ -0,0 +1,34 @@+Copyright (C) 2007 Bart Massey+ALL RIGHTS RESERVED++[This program is licensed under the "3-clause ('new') BSD License"]++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 Bart Massey, nor the names+      of other affiliated organizations, nor the names+      of other contributors may be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "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 THE COPYRIGHT OWNER OR+CONTRIBUTORS 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.

@@ -0,0 +1,349 @@+--- Copyright (C) 2007 Bart Massey+--- ALL RIGHTS RESERVED+--- Please see the end of this file for license information.++-- |This module implements reading and writing of the most+-- common kinds of WAVE files.  WAVE files are Microsoft+-- RIFF audio sample files originally based on the AIFF+-- format, and commonly have the .wav filename extension.+-- This module currently supports reading and writing+-- single-section little-endian PCM audio files containing+-- up to 32-bit samples encoded according to the well-known WAVE+-- sample encoding.  The interface audio stream format is a+-- list of frames of 32-bit (`Int32`) left-justified signed+-- PCM samples; each frame has one sample per channel.  The+-- audio reader and writer are sufficiently lazy that files+-- larger than memory can be processed.++module Data.WAVE (+  WAVE(..), WAVEHeader(..), WAVESample, WAVESamples,+  hGetWAVE, getWAVEFile,+  hPutWAVE, putWAVEFile,+  sampleToDouble, doubleToSample,+  tile, collect+) where++import Control.Monad+import System.IO+import Data.Char+import Data.Int+import Data.Word+import Data.Bits+import Data.List+import qualified Data.ByteString.Lazy as BS++-- |For internal use only; the header as it appears on-disk.+-- The interface cleans this up to remove redundancy and+-- make things easier to understand.+data WAVERawHeader = WAVERawHeader { rawNumChannels :: Int,+                                     rawSampleRate :: Int,+                                     rawByteRate :: Int,+                                     rawBlockAlign :: Int,+                                     rawBitsPerSample :: Int,+                                     rawFrames :: Maybe Int }++-- |Descriptive information for the audio source.+data WAVEHeader = WAVEHeader { waveNumChannels :: Int  -- ^Samples per frame.+                             , waveFrameRate :: Int -- ^Frames per second.+                             , waveBitsPerSample :: Int -- ^Number of+                                 -- significant bits of left-justified value.+                             , waveFrames :: Maybe Int -- ^If present,+                                 -- number of frames in the stream.+                                 -- Otherwise, can be (inefficiently)+                                 -- inferred from the length of the+                                 -- stream.+                             }++-- |Each sample is a left-justified signed integer, with+-- significant bits as given in the header.+type WAVESample = Int32++-- |A stream is a list of frames, each of which is a list of+-- samples with one sample per channel.+type WAVESamples = [[WAVESample]]++-- |The header and stream read or written.+data WAVE = WAVE { waveHeader :: WAVEHeader,+                   waveSamples :: WAVESamples }++tile :: Int -> Int -> [a] -> [[a]]+tile _ _ [] = []+tile n o s =+    let cur = take n s+        rest = drop (n - o) s in+    cur : (tile n o rest)++collect :: Int -> [a] -> [[a]]+collect n s = tile n 0 s++bits_to_bytes :: (Integral a) => a -> a+bits_to_bytes n = (n + 7) `div` 8++-- |Utility routine for working with audio data in floating+-- point format.+sampleToDouble :: WAVESample -> Double+sampleToDouble v =+    let maxb = fromIntegral (maxBound :: WAVESample)+        minb = fromIntegral (minBound :: WAVESample) in+    if v >= 0+    then fromIntegral v / maxb+    else -(fromIntegral v) / minb++-- |Utility routine for working with audio data in floating+-- point format.+doubleToSample :: Double -> WAVESample+doubleToSample v =+    let maxb = fromIntegral (maxBound :: WAVESample)+        minb = fromIntegral (minBound :: WAVESample) in+    if v >= 0+    then (fromIntegral . floor . (* maxb)) (min v 1)+    else (fromIntegral . ceiling . (* minb)) (min (-v) 1)++bs_to_string :: BS.ByteString -> String+bs_to_string b =  map (chr . fromIntegral) (BS.unpack b)++match :: Handle -> String -> IO ()+match h s = do+  b <- BS.hGet h (length s)+  unless (bs_to_string b == s)+         (error ("mismatched format string '" ++ s ++ "'"))++convert_nbytes_lend :: (Num a) => [Word8] -> a+convert_nbytes_lend bs =+  foldl accum 0 (reverse bs)+  where+    accum a b = 256 * a + fromIntegral b++get_nbytes_lend :: Handle -> Int -> IO Int+get_nbytes_lend h n = do+  bytes <- BS.hGet h n+  return (convert_nbytes_lend (BS.unpack bytes))++get_word_lend :: Handle -> IO Int+get_word_lend h = get_nbytes_lend h 4++get_halfword_lend :: Handle -> IO Int+get_halfword_lend h = get_nbytes_lend h 2++get_wave_header :: Handle -> IO WAVERawHeader+get_wave_header h = do+  size <- get_word_lend h+  audio_format <- get_halfword_lend h+  unless (audio_format == 1)+         (error "PCM only for now")+  unless (size == 16)+         (error "bad PCM chunk size")+  num_channels <- get_halfword_lend h+  frame_rate <- get_word_lend h+  byte_rate <- get_word_lend h+  block_align <- get_halfword_lend h+  bits_per_sample <- get_halfword_lend h+  return (WAVERawHeader { rawNumChannels = num_channels,+                          rawSampleRate = frame_rate,+                          rawByteRate = byte_rate,+                          rawBlockAlign = block_align,+                          rawBitsPerSample = bits_per_sample,+                          rawFrames = Nothing })+  +skip_chunk :: Handle -> IO ()+skip_chunk h = do+  size <- get_word_lend h+  hSeek h RelativeSeek (fromIntegral size)++get_wave_data :: Handle -> WAVERawHeader -> IO (WAVERawHeader, WAVESamples)+get_wave_data h hd = do+  size <- get_word_lend h+  let bits_per_sample = rawBitsPerSample hd+  let bytes_per_sample = bits_to_bytes bits_per_sample+  when (rawBlockAlign hd /= bytes_per_sample * rawNumChannels hd)+       (error "internal error: align and bits disagree")+  let frames = size `div` rawBlockAlign hd+  let count = frames * rawNumChannels hd+  samples <- case bytes_per_sample of+               1 -> do+                 bytes <- BS.hGet h count+                 return (map convert_byte (BS.unpack bytes))+               n | n <= 4 -> do+                 bytes <- BS.hGet h (count * n)+                 let words = collect n (BS.unpack bytes)+                 return (map (convert_multibyte n) words)+               _ -> error "max 32 bits per sample for now"+  let samples' = map (mask bits_per_sample) samples+  return (hd { rawFrames = Just frames },+          collect (rawNumChannels hd) samples')+  where+    convert_byte =+        (`shift` 24) .+        (fromIntegral :: Int8 -> WAVESample) .+        (fromIntegral :: Word8 -> Int8)+    convert_multibyte n =+        (`shift` (32 - 8 * n)) .+        (convert_nbytes_lend :: [Word8] -> WAVESample)+    mask bits v =+        (v .&. (((1 `shift` bits) - 1) `shift` (32 - bits)))++  +cook_header :: WAVERawHeader -> WAVEHeader+cook_header (WAVERawHeader { rawNumChannels = nc,+                             rawSampleRate = sr,+                             rawBitsPerSample = bps,+                             rawBlockAlign = ba,+                             rawFrames = Just s }) =+    WAVEHeader { waveNumChannels = nc,+                 waveFrameRate = sr,+                 waveBitsPerSample = bps,+                 waveFrames = Just s }++get_chunks :: Handle -> Maybe WAVERawHeader -> Maybe WAVESamples -> IO WAVE+get_chunks _ (Just hd) (Just s) =+    return WAVE { waveHeader = cook_header hd,+                  waveSamples = s }+get_chunks h mh ms = do+    s <- get_chunk_header+    process_chunk s mh ms+    where+      get_chunk_header = do+        bs <- BS.hGet h 4+        return (bs_to_string bs)+      process_chunk "fmt " Nothing Nothing = do+        nh <- get_wave_header h+        get_chunks h (Just nh) ms+      process_chunk "fmt " _ _ =+          error "duplicate fmt chunk in WAVE"+      process_chunk "data" (Just nh) Nothing = do+        (nh', nd) <- get_wave_data h nh+        get_chunks h (Just nh') (Just nd)+      process_chunk "data" _ _ =+          error "no fmt chunk or duplicate data chunk in WAVE"+      process_chunk _ nh ms = do+        skip_chunk h+        get_chunks h nh ms++-- |Read the WAVE file at the given handle and return the audio data.+hGetWAVE :: Handle -> IO WAVE+hGetWAVE h = do+    hSetBinaryMode h True+    hSetBuffering h (BlockBuffering Nothing)+    match h "RIFF"+    size <- get_word_lend h+    match h "WAVE"+    wav <- get_chunks h Nothing Nothing+    return wav++-- |Read the WAVE file at the given path and return the audio data.+getWAVEFile :: String -> IO WAVE+getWAVEFile fn = do+    h <- openFile fn ReadMode+    wav <- hGetWAVE h+    hClose h+    return wav++unconvert_nbytes_lend :: Int -> Int -> [Word8]+unconvert_nbytes_lend 0 _ = []+unconvert_nbytes_lend n v =+    (fromIntegral (v .&. 255)) :+      (unconvert_nbytes_lend (n - 1) (v `shift` (-8)))++put_nbytes_lend :: Handle -> Int -> Int -> IO ()+put_nbytes_lend h n v = do+  let bytes = BS.pack (unconvert_nbytes_lend n v)+  BS.hPut h bytes++put_word_lend :: Handle -> Int -> IO ()+put_word_lend h v = put_nbytes_lend h 4 v++put_halfword_lend :: Handle -> Int -> IO ()+put_halfword_lend h v = put_nbytes_lend h 2 v++put_wave_header :: Handle -> WAVEHeader -> IO ()+put_wave_header h hd = do+  put_halfword_lend h 1   --- PCM+  let num_channels = waveNumChannels hd+  put_halfword_lend h num_channels+  let frame_rate = waveFrameRate hd+  put_word_lend h frame_rate+  let bytes_per_sample = bits_to_bytes (waveBitsPerSample hd)+  let block_align = bytes_per_sample * num_channels+  let byte_rate = frame_rate * block_align+  put_word_lend h byte_rate+  put_halfword_lend h block_align+  put_halfword_lend h (waveBitsPerSample hd)++put_wave_data :: Handle -> WAVEHeader -> [WAVESample] -> IO ()+put_wave_data h hd sa = do+  let nb = bits_to_bytes (waveBitsPerSample hd)+  when (nb <= 0 || nb > 4)+       (error "supported sample sizes 1..32 bits for now")+  let saa = map ((flip shift) (8 * nb - 32)) sa+  let ba = if nb == 1+           then map (fromIntegral . (.&. 255) . (+ 128)) saa+           else concatMap (unconvert_nbytes_lend nb . fromIntegral) saa+  let bytes = BS.pack ba+  BS.hPut h bytes++-- |Write the given audio data to the given handle as a WAVE file.+hPutWAVE :: Handle -> WAVE -> IO ()+hPutWAVE h wav = do+  hSetBinaryMode h True+  hSetBuffering h (BlockBuffering Nothing)+  ---+  let header = waveHeader wav+  let samples = waveSamples wav+  let frame_count = case waveFrames header of+                       Just n -> n+                       Nothing -> length samples+  let frame_samples = frame_count * waveNumChannels header+  let header_size = 2 + 2 + 4 + 4 + 2 + 2+  let bytes_per_sample = bits_to_bytes (waveBitsPerSample header)+  let data_size = frame_samples * bytes_per_sample+  ---+  hPutStr h "RIFF"+  put_word_lend h (4 + header_size + 8 + data_size + 8)+  hPutStr h "WAVE"+  ---+  hPutStr h "fmt "+  put_word_lend h header_size+  put_wave_header h header+  ---+  hPutStr h "data"+  put_word_lend h data_size+  put_wave_data h header (concat samples)++-- |Write the given audio data to the given path as a WAVE file.+putWAVEFile :: String -> WAVE -> IO ()+putWAVEFile fn wav = do+    h <- openFile fn WriteMode+    hPutWAVE h wav+    hClose h++++--- 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 Bart Massey, nor the names+---       of other affiliated organizations, nor the names+---       of other contributors may be used to endorse or promote+---       products derived from this software without specific prior+---       written permission.+--- +--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+--- CONTRIBUTORS "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 THE COPYRIGHT OWNER OR+--- CONTRIBUTORS 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.

@@ -0,0 +1,22 @@+WAVE -- WAVE format audio file IO library+version 0.1+Bart Massey <bart@cs.pdx.edu>+8 March 2008++This library provides Data.WAVE, a module for reading and+writing audio files in the WAVE audio format.  See the+Haddock documentation for the gory details.++I have used this code with ghc 6.6 and ghc 6.8 on Linux,+although the current cabal setup has only been tested with+cabal 1.2 and ghc 6.8.  It is a fairly standard+Hackage-ready package, to the extent I know how to construct+such.++This is definitely a simple implementation: a number of+"advanced" WAVE features are not supported (such as+nonlinear encodings), and non-WAVE audio files are in no way+supported.  I thought others might find it useful, though; I+also have released other code that depends on it.++Have fun with it, and let me know if there are problems.

@@ -0,0 +1,7 @@+--- Copyright (C) 2007 Bart Massey+--- ALL RIGHTS RESERVED+--- Please see the file COPYING in this software+--- distribution for license information.++import Distribution.Simple+main = defaultMain

@@ -0,0 +1,16 @@+Name: WAVE+Description: Module for reading and writing audio files in the WAVE audio format.+Build-Type: Simple+Version: 0.1+License: BSD3+License-File: COPYING+Author: Bart Massey <bart@cs.pdx.edu>+Copyright: Copyright (C) 2007 Bart Massey+Maintainer: Bart Massey <bart@cs.pdx.edu>+Homepage: http://wiki.cs.pdx.edu/bartforge/wave+Category: Data+Build-Depends: base, bytestring+Synopsis: WAVE audio file IO library+Exposed-Modules: Data.WAVE+Stability: Alpha+Extra-Source-Files: README