summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormtolly <>2014-06-30 17:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-06-30 17:46:00 (GMT)
commit774bcc1733c87a3784761a7499a5504edbeca61e (patch)
tree16d0853a83803b41484e5350aae306343bce811c
parentc7ab62a760dbba543cbeffd2ed4906fbe343b498 (diff)
version 0.1.0.10.1.0.1
-rw-r--r--rubberband.cabal21
-rw-r--r--src/Sound/RubberBand/Nice.hs57
2 files changed, 39 insertions, 39 deletions
diff --git a/rubberband.cabal b/rubberband.cabal
index 242897e..9f34126 100644
--- a/rubberband.cabal
+++ b/rubberband.cabal
@@ -1,20 +1,21 @@
name: rubberband
-version: 0.1
+version: 0.1.0.1
synopsis: Binding to the C++ audio stretching library Rubber Band
-description: Rubber Band is a high quality software library for audio
+description: <http://breakfastquay.com/rubberband/ Rubber Band Library>
+ is a high quality software library for audio
time-stretching and pitch-shifting. It permits you to
change the tempo and pitch of an audio stream or recording
dynamically and independently of one another.
.
- Rubber Band is open source software under the GNU General
- Public License. If you want to distribute it in a
- proprietary commercial application, you need to buy a
- license: <http://breakfastquay.com/rubberband/license.html>
+ Rubber Band Library is open source software under the GNU
+ General Public License. If you want to distribute it in a
+ proprietary commercial application, you need to
+ <http://breakfastquay.com/rubberband/license.html buy a license>.
.
- This is a binding to Rubber Band library v1.8.1.
+ This is a binding to Rubber Band Library v1.8.1.
-homepage: http://breakfastquay.com/rubberband/
+homepage: https://github.com/mtolly/rubberband
license: GPL-3
license-file: LICENSE
author: Michael Tolly
@@ -22,6 +23,7 @@ maintainer: miketolly@gmail.com
category: Sound
build-type: Simple
cabal-version: >=1.10
+bug-reports: https://github.com/mtolly/rubberband/issues
library
exposed-modules: Sound.RubberBand
@@ -33,8 +35,9 @@ library
default-language: Haskell2010
includes: rubberband/rubberband-c.h
extra-libraries: rubberband
+ pkgconfig-depends: rubberband == 1.8.1
ghc-options: -Wall
Source-Repository head
type: git
- location: git://github.com/mtolly/rubberband.git
+ location: https://github.com/mtolly/rubberband
diff --git a/src/Sound/RubberBand/Nice.hs b/src/Sound/RubberBand/Nice.hs
index 2c140a9..06b0c0d 100644
--- a/src/Sound/RubberBand/Nice.hs
+++ b/src/Sound/RubberBand/Nice.hs
@@ -73,16 +73,18 @@ import Foreign
(Ptr, ForeignPtr, newForeignPtr, withForeignPtr, finalizerFree, castPtr)
import Control.Applicative ((<$>))
import Foreign.Marshal.Array (withArray, withArrayLen, mallocArray)
+import Foreign.Marshal.Utils (withMany)
import qualified Data.Vector.Storable as V
import Foreign.C.Types (CFloat)
import Control.Monad (guard, forM, replicateM)
+import Data.List (foldl')
-- | An audio stretching machine. This object is garbage-collected on the
-- Haskell side, so it will be deleted automatically.
newtype Stretcher = Stretcher (ForeignPtr Raw.Stretcher)
deriving (Eq, Ord, Show)
--- | Allows you to use the functions in "Sound.RubberBand.Nice" if needed.
+-- | Allows you to use the functions in "Sound.RubberBand.Raw" if needed.
withRaw :: Stretcher -> (Raw.Stretcher -> IO a) -> IO a
withRaw (Stretcher fp) f = withForeignPtr fp $ f . Raw.Stretcher
@@ -143,18 +145,18 @@ corresponding to a shift of @s@ equal-tempered semitones (where @s@
is positive for an upwards shift and negative for downwards) is
@2 ** (s / 12)@.
-If the stretcher was constructed in Offline mode, the pitch
+If the stretcher was constructed in 'Offline' mode, the pitch
scaling ratio is fixed throughout operation; this function may
be called any number of times between construction (or a call
to 'reset') and the first call to 'study' or 'process', but may
not be called after 'study' or 'process' has been called.
-If the stretcher was constructed in RealTime mode, the pitch
+If the stretcher was constructed in 'RealTime' mode, the pitch
scaling ratio may be varied during operation; this function may
be called at any time, so long as it is not called concurrently
with 'process'. You should either call this function from the
same thread as 'process', or provide your own mutex or similar
-mechanism to ensure that setPitchScale and 'process' cannot be
+mechanism to ensure that 'setPitchScale' and 'process' cannot be
run at once (there is no internal mutex for this purpose).
-}
setPitchScale :: Stretcher -> PitchScale -> IO ()
@@ -323,28 +325,17 @@ setKeyFrameMap s pairs = withRaw s $ \r ->
withArray (map (fromIntegral . snd) pairs) $ \p2 ->
Raw.setKeyFrameMap r (length pairs) p1 p2
-unsafeWiths :: (V.Storable e) => [V.Vector e] -> ([Ptr e] -> IO a) -> IO a
-unsafeWiths [] f = f []
-unsafeWiths (x : xs) f =
- V.unsafeWith x $ \p ->
- unsafeWiths xs $ \ps ->
- f $ p : ps
-
-getUniform :: (Eq a) => [a] -> Maybe a
-getUniform (x : xs) = guard (all (== x) xs) >> Just x
-getUniform [] = Nothing
-
-- | Ugly, but needed to share the code for 'study' and 'process'.
studyProcess ::
String -> (Raw.Stretcher -> Ptr (Ptr CFloat) -> Int -> Bool -> IO ()) ->
Stretcher -> [V.Vector Float] -> Bool -> IO ()
studyProcess fname f s chans final = do
- samples <- case getUniform $ map V.length chans of
- Nothing -> error $ fname ++ ": " ++ if null chans
- then "no input arrays given"
- else "input arrays have differing lengths"
- Just sam -> return sam
- unsafeWiths chans $ \pfs ->
+ let samples = foldl' max 0 $ map V.length chans
+ lengthen vect = case samples - V.length vect of
+ 0 -> vect
+ d -> vect V.++ V.replicate d 0 -- pad right end with zero samples
+ chans' = map lengthen chans
+ withMany V.unsafeWith chans' $ \pfs ->
withArrayLen pfs $ \len ppf -> do
numchans <- getChannelCount s
if numchans == len
@@ -357,28 +348,34 @@ studyProcess fname f s chans final = do
]
{- |
-Provide a block of "samples" sample frames for the stretcher to
+Provide a block of sample frames for the stretcher to
study and calculate a stretch profile from.
This is only meaningful in 'Offline' mode, and is required if
running in that mode. You should pass the entire input through
'study' before any 'process' calls are made, as a sequence of
blocks in individual 'study' calls, or as a single large block.
-
-The input list should be de-interleaved audio data with one float vector
-per channel. The 'Bool' should be 'True' if this is the last block of data
-that will be provided to 'study' before the first 'process' call.
-}
-study :: Stretcher -> [V.Vector Float] -> Bool -> IO ()
+study
+ :: Stretcher
+ -> [V.Vector Float]
+ -- ^ De-interleaved audio data, one vector per channel.
+ -> Bool
+ -- ^ 'True' if this is the last block of data
+ -- that will be provided to 'study' before the first 'process' call.
+ -> IO ()
study = studyProcess "study" Raw.study
{- |
Provide a block of sample frames for processing.
See also 'getSamplesRequired' and 'setMaxProcessSize'.
-
-Set the 'Bool' to 'True' if this is the last block of input data.
-}
-process :: Stretcher -> [V.Vector Float] -> Bool -> IO ()
+process
+ :: Stretcher
+ -> [V.Vector Float]
+ -> Bool
+ -- ^ 'True' if this is the last block of input data.
+ -> IO ()
process = studyProcess "process" Raw.process
{- |