module Sound.File.Sndfile.Buffer
(
MBuffer(..),
checkSampleBounds, checkFrameBounds,
hReadSamples, hReadFrames,
interact,
IOFunc,
sf_read_double, sf_readf_double,
sf_write_double, sf_writef_double,
sf_read_float, sf_readf_float,
sf_write_float, sf_writef_float
) where
import Control.Monad (liftM, when)
import Data.Array.Base (unsafeRead, unsafeWrite)
import Data.Array.MArray (Ix, MArray, getBounds, newArray_)
import Data.Ix (rangeSize)
import Foreign.Ptr (Ptr)
import Foreign.C.Types (CLLong)
import Prelude hiding (interact)
import Sound.File.Sndfile.Exception (throw)
import Sound.File.Sndfile.Interface
checkSampleBounds :: (Monad m) => Count -> Int -> Count -> m ()
checkSampleBounds size channels count
| (count `mod` channels) /= 0 = throw 0 ("invalid channel/count combination " ++ (show count))
| (count < 0) || (count > size) = throw 0 ("index out of bounds")
| otherwise = return ()
checkFrameBounds :: (Monad m) => Count -> Int -> Count -> m ()
checkFrameBounds size channels count
| (size `mod` channels) /= 0 = throw 0 ("invalid buffer size")
| (count < 0) || (count > (size `quot` channels)) = throw 0 ("index out of bounds")
| otherwise = return ()
type IOFunc a = HandlePtr -> Ptr a -> CLLong -> IO CLLong
foreign import ccall unsafe "sf_read_double" sf_read_double :: IOFunc Double
foreign import ccall unsafe "sf_readf_double" sf_readf_double :: IOFunc Double
foreign import ccall unsafe "sf_write_double" sf_write_double :: IOFunc Double
foreign import ccall unsafe "sf_writef_double" sf_writef_double :: IOFunc Double
foreign import ccall unsafe "sf_read_float" sf_read_float :: IOFunc Float
foreign import ccall unsafe "sf_readf_float" sf_readf_float :: IOFunc Float
foreign import ccall unsafe "sf_write_float" sf_write_float :: IOFunc Float
foreign import ccall unsafe "sf_writef_float" sf_writef_float :: IOFunc Float
class (MArray a e m) => MBuffer a e m where
hGetSamples :: Handle -> a Index e -> Count -> m Count
hGetFrames :: Handle -> a Index e -> Count -> m Count
hPutSamples :: Handle -> a Index e -> Count -> m Count
hPutFrames :: Handle -> a Index e -> Count -> m Count
unsafeWriteRange :: (MArray a e m) => a Int e -> (Int, Int) -> e -> m ()
unsafeWriteRange _ (i0, i) _ | i0 > i = return ()
unsafeWriteRange a (i0, i) e = unsafeWrite a i0 e >> unsafeWriteRange a (i0+1,i) e
hReadSamples :: (MBuffer a e m, Num e) => Handle -> Count -> m (Maybe (a Index e))
hReadSamples h n = do
b <- newArray_ (0, n1)
n' <- hGetSamples h b n
if n' == 0
then return Nothing
else do
when (n' < n) (unsafeWriteRange b (n',n1) 0)
return (Just b)
hReadFrames :: (MBuffer a e m, Num e) => Handle -> Count -> m (Maybe (a Index e))
hReadFrames h n = do
b <- newArray_ (0, si)
n' <- hGetFrames h b n
if n' == 0
then return Nothing
else do
when (n' < n) (unsafeWriteRange b (f2s n', si) 0)
return (Just b)
where
f2s = (* channels (hInfo h))
si = (f2s n) 1
modifyArray :: (MArray a e m, Ix i) => (e -> e) -> a i e -> Int -> Int -> m ()
modifyArray f a i n
| i >= n = return ()
| otherwise = do
e <- unsafeRead a i
unsafeWrite a i (f e)
modifyArray f a (i+1) n
interact :: (MBuffer a e m) => (e -> e) -> a Index e -> Handle -> Handle -> m ()
interact f buffer hIn hOut = do
s <- liftM rangeSize $ getBounds buffer
n <- hGetSamples hIn buffer s
when (n > 0) $ do
modifyArray f buffer 0 n
hPutSamples hOut buffer n
interact f buffer hIn hOut