soxlib 0.0.2 → 0.0.2.1
raw patch · 4 files changed
+65/−44 lines, 4 files
Files
- soxlib.cabal +5/−5
- src/Sound/SoxLib.hs +14/−17
- src/Sound/SoxLib/FFI.hsc +37/−14
- src/Sound/SoxLib/Template.h +9/−8
soxlib.cabal view
@@ -1,5 +1,5 @@ Name: soxlib-Version: 0.0.2+Version: 0.0.2.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -22,13 +22,13 @@ src/Sound/SoxLib/Template.h Source-Repository this- Tag: 0.0.2+ Tag: 0.0.2.1 Type: darcs- Location: http://code.haskell.org/~thielema/soxlib/+ Location: http://hub.darcs.net/thielema/soxlib/ Source-Repository head Type: darcs- Location: http://code.haskell.org/~thielema/soxlib/+ Location: http://hub.darcs.net/thielema/soxlib/ Flag buildExamples description: Build example executables@@ -55,7 +55,7 @@ Other-Modules: Sound.SoxLib.FFI - PkgConfig-Depends: sox >=14.3 && <14.4+ PkgConfig-Depends: sox >=14.3 && <14.5 Executable soxlib-demo Main-Is: demo/Demo.hs
src/Sound/SoxLib.hs view
@@ -112,7 +112,7 @@ withRead :: ReaderInfo -> FilePath ->- (Ptr (FFI.Format FFI.ReadMode) -> IO a) -> IO a+ (FFI.FormatPtr FFI.ReadMode -> IO a) -> IO a withRead info path = bracket (openRead info path) close @@ -120,9 +120,7 @@ This function will never return a 'nullPtr'. Instead it throws a user exception if the file cannot be opened. -}-openRead ::- ReaderInfo -> FilePath ->- IO (Ptr (FFI.Format FFI.ReadMode))+openRead :: ReaderInfo -> FilePath -> IO (FFI.FormatPtr FFI.ReadMode) openRead info path = flip MC.runContT return $ do si <- withMaybe U.with $ readerSignalInfo info@@ -147,7 +145,7 @@ withWrite :: WriterInfo -> FilePath ->- (Ptr (FFI.Format FFI.WriteMode) -> IO a) -> IO a+ (FFI.FormatPtr FFI.WriteMode -> IO a) -> IO a withWrite info path = bracket (openWrite info path) close @@ -155,9 +153,7 @@ This function will never return a 'nullPtr'. Instead it throws a user exception if the file cannot be opened. -}-openWrite ::- WriterInfo -> FilePath ->- IO (Ptr (FFI.Format FFI.WriteMode))+openWrite :: WriterInfo -> FilePath -> IO (FFI.FormatPtr FFI.WriteMode) openWrite info path = flip MC.runContT return $ do si <- withMaybe U.with $ writerSignalInfo info@@ -184,7 +180,7 @@ -close :: FFI.Mode mode => Ptr (FFI.Format mode) -> IO ()+close :: FFI.Mode mode => FFI.FormatPtr mode -> IO () close = void . FFI.close @@ -193,7 +189,7 @@ @size@ must be divisible by the number of channels. -} readStorableVector ::- Ptr (FFI.Format FFI.ReadMode) -> Int -> IO (SV.Vector Int32)+ FFI.FormatPtr FFI.ReadMode -> Int -> IO (SV.Vector Int32) readStorableVector fmt size = SVB.createAndTrim size $ \ptr -> fmap fromIntegral $ FFI.read fmt ptr (fromIntegral size)@@ -203,7 +199,7 @@ @size@ must be divisible by the number of channels. -} writeStorableVector ::- Ptr (FFI.Format FFI.WriteMode) -> SV.Vector Int32 -> IO ()+ FFI.FormatPtr FFI.WriteMode -> SV.Vector Int32 -> IO () writeStorableVector fmt chunk = SVB.withStartPtr chunk $ \ptr len -> do written <- FFI.write fmt ptr (fromIntegral len)@@ -217,28 +213,29 @@ The chunkSize must be divisible by the number of channels. -} readStorableVectorLazy ::- Ptr (FFI.Format FFI.ReadMode) -> SVL.ChunkSize -> IO (SVL.Vector Int32)+ FFI.FormatPtr FFI.ReadMode -> SVL.ChunkSize -> IO (SVL.Vector Int32) readStorableVectorLazy fmt (SVL.ChunkSize size) = let go = unsafeInterleaveIO $ do chunk <- readStorableVector fmt size if SV.length chunk >= size then fmap (chunk:) go- else if SV.length chunk == 0- then return []- else return [chunk]+ else return $+ if SV.length chunk == 0+ then []+ else [chunk] in fmap SVL.fromChunks go {- | The chunkSize must be divisible by the number of channels. -} writeStorableVectorLazy ::- Ptr (FFI.Format FFI.WriteMode) -> SVL.Vector Int32 -> IO ()+ FFI.FormatPtr FFI.WriteMode -> SVL.Vector Int32 -> IO () writeStorableVectorLazy fmt = mapM_ (writeStorableVector fmt) . SVL.chunks -seek :: (FFI.Mode mode) => Ptr (FFI.Format mode) -> Int -> IO ()+seek :: (FFI.Mode mode) => FFI.FormatPtr mode -> Int -> IO () seek fmt pos = do res <- FFI.seek fmt (fromIntegral pos) 0 when (res /= 0) $ do
src/Sound/SoxLib/FFI.hsc view
@@ -16,8 +16,6 @@ import Data.Maybe.HT (toMaybe, ) import Data.Maybe (fromMaybe, ) -import qualified Data.Word as Word--- import qualified Data.Int as Int -- we must import it unqualified, because Hsc calls it that way import Data.Word import Data.Int@@ -43,6 +41,8 @@ show (IOType n) = error $ "SoxLib.IOType.show: invalid number " ++ show n +type FormatPtr mode = Ptr (Format mode)+ data Format mode = Format { filename :: FilePath,@@ -163,16 +163,30 @@ newtype Option = Option #{type sox_option_t} deriving (Storable) +#if SOX_LIB_VERSION_CODE < SOX_LIB_VERSION(14, 4, 0)++#define OPTION_NO SOX_OPTION_NO+#define OPTION_YES SOX_OPTION_YES+#define OPTION_DEFAULT SOX_OPTION_DEFAULT++#else++#define OPTION_NO sox_option_no+#define OPTION_YES sox_option_yes+#define OPTION_DEFAULT sox_option_default++#endif+ #{enum Option, Option- , optionNo = SOX_OPTION_NO- , optionYes = SOX_OPTION_YES- , optionDefault = SOX_OPTION_DEFAULT+ , optionNo = OPTION_NO+ , optionYes = OPTION_YES+ , optionDefault = OPTION_DEFAULT } instance Show Option where- show (Option #{const SOX_OPTION_NO }) = "optionNo"- show (Option #{const SOX_OPTION_YES }) = "optionYes"- show (Option #{const SOX_OPTION_DEFAULT}) = "optionDefault"+ show (Option #{const OPTION_NO }) = "optionNo"+ show (Option #{const OPTION_YES }) = "optionYes"+ show (Option #{const OPTION_DEFAULT}) = "optionDefault" show (Option n) = error $ "SoxLib.Option.show: invalid number " ++ show n @@ -336,19 +350,28 @@ formatQuit :: IO () foreign import ccall unsafe "sox.h sox_open_read"- openRead :: CStr.CString -> Ptr SignalInfo -> Ptr EncodingInfo -> CFileType -> IO (Ptr (Format ReadMode))+ openRead :: CStr.CString -> Ptr SignalInfo -> Ptr EncodingInfo -> CFileType -> IO (FormatPtr ReadMode) +foreign import ccall safe "sox.h sox_open_mem_read"+ openMemRead :: Ptr Word8 -> C.CSize -> Ptr SignalInfo -> Ptr EncodingInfo -> CStr.CString -> IO (FormatPtr ReadMode)+ foreign import ccall safe "sox.h sox_open_write"- openWrite :: CStr.CString -> Ptr SignalInfo -> Ptr EncodingInfo -> CFileType -> Ptr OOB -> FunPtr (CStr.CString -> IO Bool) -> IO (Ptr (Format WriteMode))+ openWrite :: CStr.CString -> Ptr SignalInfo -> Ptr EncodingInfo -> CFileType -> Ptr OOB -> FunPtr (CStr.CString -> IO Bool) -> IO (FormatPtr WriteMode) +foreign import ccall safe "sox.h sox_open_mem_write"+ openMemWrite :: Ptr Word8 -> C.CSize -> Ptr SignalInfo -> Ptr EncodingInfo -> CFileType -> Ptr OOB -> IO (FormatPtr WriteMode)++foreign import ccall safe "sox.h sox_open_memstream_write"+ openMemstreamWrite :: Ptr (Ptr Word8) -> Ptr C.CSize -> Ptr SignalInfo -> Ptr EncodingInfo -> CFileType -> Ptr OOB -> IO (FormatPtr WriteMode)+ foreign import ccall unsafe "sox.h sox_read"- read :: Ptr (Format ReadMode) -> Ptr Sample -> C.CSize -> IO C.CSize+ read :: FormatPtr ReadMode -> Ptr Sample -> C.CSize -> IO C.CSize foreign import ccall unsafe "sox.h sox_write"- write :: Ptr (Format WriteMode) -> Ptr Sample -> C.CSize -> IO C.CSize+ write :: FormatPtr WriteMode -> Ptr Sample -> C.CSize -> IO C.CSize foreign import ccall unsafe "sox.h sox_close"- close :: Ptr (Format mode) -> IO C.CInt+ close :: FormatPtr mode -> IO C.CInt foreign import ccall unsafe "sox.h sox_seek"- seek :: Ptr (Format mode) -> C.CSize -> Whence -> IO C.CInt+ seek :: FormatPtr mode -> C.CSize -> Whence -> IO C.CInt
src/Sound/SoxLib/Template.h view
@@ -1,29 +1,30 @@ #include <stdio.h>+#include <inttypes.h> /* http://www.haskell.org/haskellwiki/FFICookBook#Working_with_structs */ #define hsc_alignment(t) \ printf("(%ld)", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)); #define hsc_inttype(t) \- printf ("%s%lu", \- (t)(-1) < (t)0 ? "Int.Int" : "Word.Word", \- (unsigned long)sizeof (t) * 8); \+ printf ("%s%lu", \+ (t)(-1) < (t)0 ? "Int" : "Word", \+ (unsigned long)sizeof (t) * 8); #define hsc_intfieldtype(t,f) \ { \ t x, y; \ x.f = -1; \ y.f = 0; \- printf ("%s%lu", \- x.f < y.f ? "Int.Int" : "Word.Word", \- (unsigned long)sizeof (x.f) * 8); \+ printf ("%s%lu", \+ x.f < y.f ? "Int" : "Word", \+ (unsigned long)sizeof (x.f) * 8); \ } #define hsc_peek_int(t, f) \ { \ t *x = 0; \ printf ("(\\hsc_ptr -> fmap fromIntegral (peekByteOff hsc_ptr %ld :: IO ", \- (long) &(x->f)); \+ (uintptr_t) &(x->f)); \ hsc_intfieldtype (t, f) \ printf ("))"); \ }@@ -32,7 +33,7 @@ { \ t *x = 0; \ printf ("(\\hsc_ptr hsc_x -> pokeByteOff hsc_ptr %ld (fromIntegral hsc_x :: ", \- (long) &(x->f)); \+ (uintptr_t) &(x->f)); \ hsc_intfieldtype (t, f) \ printf ("))"); \ }