WAVE-0.1: Data/WAVE.hs
--- 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.