vocoder-audio (empty) → 0.1.0.0
raw patch · 6 files changed
+381/−0 lines, 6 filesdep +basedep +conduitdep +conduit-audiosetup-changed
Dependencies added: base, conduit, conduit-audio, conduit-audio-sndfile, containers, hsndfile, mono-traversable, optparse-applicative, random, resourcet, split, vector, vector-fftw, vocoder, vocoder-audio, vocoder-conduit
Files
- ChangeLog.md +4/−0
- LICENSE +26/−0
- Setup.hs +2/−0
- example/VocoderFile.hs +174/−0
- src/Vocoder/Audio.hs +113/−0
- vocoder-audio.cabal +62/−0
+ ChangeLog.md view
@@ -0,0 +1,4 @@+## 0.1.0.0++Initial version.+
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2020, Marek Materzok+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. 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.++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/VocoderFile.hs view
@@ -0,0 +1,174 @@+module Main where++import Options.Applicative+import Data.Semigroup ((<>))+import Data.List.Split+import Text.Read+import Vocoder+import Vocoder.Window+import Vocoder.Audio+import Vocoder.Conduit.Filter+import Sound.File.Sndfile+import Data.Conduit.Audio.Sndfile+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import System.Random+import qualified Data.Vector.Storable as V++data WindowType = BoxWindow | HammingWindow | HannWindow | BlackmanWindow | FlatTopWindow deriving (Read, Show)++data Options = Options {+ optFrameSize :: Maybe Length,+ windowSize :: Length,+ hopSizeO :: HopSize,+ windowType :: WindowType,+ initPhaseRandom :: Bool,+ destFile :: String,+ sources :: [(String, Filter (ResourceT IO))]+}++initPhase :: Options -> IO Phase+initPhase opts | initPhaseRandom opts = V.replicateM (vocFreqFrameLength $ vocoderParamsFor opts) $ randomRIO (0, 2*pi)+ | otherwise = return $ zeroPhase $ vocoderParamsFor opts++frameSize :: Options -> Length+frameSize opts = maybe (windowSize opts) id $ optFrameSize opts++windowFor :: Options -> Window+windowFor opts = windowFun (windowType opts) (windowSize opts)++windowFun :: WindowType -> Length -> Window+windowFun BoxWindow = boxWindow+windowFun HammingWindow = hammingWindow+windowFun HannWindow = hannWindow+windowFun BlackmanWindow = blackmanWindow+windowFun FlatTopWindow = flatTopWindow++vocoderParamsFor :: Options -> VocoderParams+vocoderParamsFor opts = vocoderParams (frameSize opts) (hopSizeO opts) (windowFor opts)++auto2 :: (Read a, Read b) => ReadM (a, b)+auto2 = maybeReader $ f . splitOn ","+ where+ f [a,b] = (,) <$> readMaybe a <*> readMaybe b+ f _ = Nothing++auto3 :: (Read a, Read b, Read c) => ReadM (a, b, c)+auto3 = maybeReader $ f . splitOn ","+ where+ f [a,b,c] = (,,) <$> readMaybe a <*> readMaybe b <*> readMaybe c+ f _ = Nothing++uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)+uncurry3 f (a,b,c) = f a b c++sourceP :: MonadIO m => Parser (String, Filter m)+sourceP = (,) + <$> argument str (metavar "SRC")+ <*> filtersP++filtersP :: MonadIO m => Parser (Filter m)+filtersP = (\l -> if null l then idFilter else foldr1 composeFilters l) <$> many filterP++filterP :: MonadIO m => Parser (Filter m)+filterP = (lowpassBrickwall <$> option auto+ ( long "lowpassBrickwall"+ <> metavar "FREQ"+ <> help "Low-pass brickwall filter"))+ <|> (highpassBrickwall <$> option auto+ ( long "highpassBrickwall"+ <> metavar "FREQ"+ <> help "High-pass brickwall filter"))+ <|> (uncurry bandpassBrickwall <$> option auto2+ ( long "bandpassBrickwall"+ <> metavar "FREQ,FREQ"+ <> help "Band-pass brickwall filter"))+ <|> (uncurry bandstopBrickwall <$> option auto2+ ( long "bandstopBrickwall"+ <> metavar "FREQ,FREQ"+ <> help "Band-stop brickwall filter"))+ <|> (uncurry lowpassButterworth <$> option auto2+ ( long "lowpassButterworth"+ <> metavar "DEG,FREQ"+ <> help "Low-pass Butterworth-style filter"))+ <|> (uncurry highpassButterworth <$> option auto2+ ( long "highpassButterworth"+ <> metavar "DEG,FREQ"+ <> help "High-pass Butterworth-style filter"))+ <|> (uncurry3 bandpassButterworth <$> option auto3+ ( long "bandpassButterworth"+ <> metavar "DEG,FREQ,FREQ"+ <> help "Band-pass Butterworth-style filter"))+ <|> (uncurry3 bandstopButterworth <$> option auto3+ ( long "bandstopButterworth"+ <> metavar "DEG,FREQ,FREQ"+ <> help "Band-stop Butterworth-style filter"))+ <|> (amplify <$> option auto+ ( long "amplify"+ <> metavar "COEFF"+ <> help "Change amplitude"))+ <|> (pitchShiftInterpolate <$> option auto+ ( long "pitchShiftInterpolate"+ <> metavar "COEFF"+ <> help "Interpolative pitch-shift"))+ <|> (envelopeFilter <$> option auto+ ( long "envelope"+ <> metavar "KSIZE"+ <> help "Calculate spectral envelope"))+ <|> (playSpeed <$> option (toRational <$> (auto :: ReadM Double))+ ( long "playSpeed"+ <> metavar "COEFF"+ <> help "Change speed by coefficient"))+ <|> (flag' (randomPhaseFilter)+ ( long "randomPhase"+ <> help "Randomize phases (Paulstretch effect)"))++options :: Parser Options+options = Options+ <$> optional (option auto + ( long "frameSize"+ <> metavar "SIZE"+ <> help "Size of zero-padded FFT frame, must be >= windowSize"))+ <*> option auto+ ( long "windowSize"+ <> metavar "SIZE"+ <> value 1024+ <> showDefault+ <> help "Size of STFT window")+ <*> option auto+ ( long "hopSize"+ <> metavar "SIZE"+ <> value 128+ <> showDefault+ <> help "STFT hop size")+ <*> option auto+ ( long "windowType"+ <> metavar "TYPE"+ <> value BlackmanWindow+ <> showDefault+ <> help "Type of STFT window")+ <*> switch+ ( long "randomInitPhase"+ <> help "Randomize initial phase")+ <*> argument str (metavar "DST")+ <*> some sourceP++myFormat :: Format+myFormat = Format {headerFormat = HeaderFormatWav, sampleFormat = SampleFormatPcm16, endianFormat = EndianFile}++main :: IO ()+main = execParser opts >>= process + where+ opts = info (options <**> helper)+ ( fullDesc+ <> progDesc "Process audio file"+ <> header "Phase vocoder audio processing")++process :: Options -> IO ()+process opts = do+ let par = vocoderParamsFor opts+ iphs <- initPhase opts+ srcs <- forM (sources opts) $ \(n, f) -> processVocoderAudio par f <$> sourceSnd n+ runResourceT $ sinkSnd (destFile opts) myFormat $ sourceVocoderWithPhase iphs $ foldl1 concatenateV srcs+
+ src/Vocoder/Audio.hs view
@@ -0,0 +1,113 @@+{-| + Module : Vocoder.Audio+ Description : Frequency-domain filters+ Copyright : (c) Marek Materzok, 2021+ License : BSD2++This module allows easy frequency-domain processing on audio streams+created in @conduit-audio@.+-}+module Vocoder.Audio(+ VocoderAudioSource(..),+ concatenateV,+ sourceVocoder,+ sourceVocoderWithPhase,+ processAudio,+ processAudioWithPhase,+ processVocoderAudio+ ) where++import Data.Conduit+import Data.Conduit.Audio+import qualified Data.Conduit.Combinators as DCC+import Control.Applicative+import Control.Monad+import Vocoder+import Vocoder.Conduit+import Vocoder.Conduit.Filter+import Vocoder.Conduit.Frames+import qualified Data.Vector.Storable as V++data VocoderAudioSource m = VocoderAudioSource {+ sourceV :: (Frame, (ZipList Phase, ZipList Phase)) + -> ConduitT () Frame m (V.Vector Double, (ZipList Phase, ZipList Phase)),+ rateV :: Rate,+ channelsV :: Channels,+ framesV :: Frames,+ vocoderParamsV :: VocoderParams+}++-- | Applies a conduit filter to an audio stream, producing a vocoder stream.+-- This allows to seamlessly concatenate audio streams for vocoder processing.+processVocoderAudio + :: Monad m+ => VocoderParams+ -> Filter m+ -> AudioSource m Double + -> VocoderAudioSource m+processVocoderAudio par c src = VocoderAudioSource newSource (rate src) (channels src) (frames src) par where+ freqStep = rate src / fromIntegral (vocFrameLength par)+ newSource (q, ps) = + (source src .| genFramesOfE (vocInputFrameLength par * channels src) (vocHopSize par * channels src) q)+ `fuseBoth`+ (DCC.map (ZipList . deinterleave (channels src)) .| (snd <$> processFramesF par ps (runFilter c freqStep)))+ `fuseUpstream`+ DCC.map (interleave . getZipList)++-- | Connects the end of the first vocoder source to the beginning of the second. +-- The two sources must have the same sample rate, channel count, vocoder hop size+-- and frame length.+concatenateV :: Monad m + => VocoderAudioSource m+ -> VocoderAudioSource m+ -> VocoderAudioSource m+concatenateV src1 src2 + | rateV src1 /= rateV src2 = error "Vocoder.Audio.concatenateV: mismatched rates"+ | channelsV src1 /= channelsV src2 = error "Vocoder.Audio.concatenateV: mismatched channels"+ | vocHopSize par1 /= vocHopSize par2 = error "Vocoder.Audio.concatenateV: mismatched hop size"+ | vocFrameLength par1 /= vocFrameLength par2 = error "Vocoder.Audio.concatenateV: mismatched frame length"+ | otherwise = VocoderAudioSource (sourceV src1 >=> sourceV src2) (rateV src1) (channelsV src1) (framesV src1 + framesV src2) (vocoderParamsV src1)+ where+ par1 = vocoderParamsV src1+ par2 = vocoderParamsV src2++-- | Creates an audio source from a vocoder source.+sourceVocoder :: Monad m + => VocoderAudioSource m+ -> AudioSource m Double+sourceVocoder src = sourceVocoderWithPhase (zeroPhase $ vocoderParamsV src) src++-- | Creates an audio source from a vocoder source, with initial phase provided.+sourceVocoderWithPhase + :: Monad m + => Phase+ -> VocoderAudioSource m+ -> AudioSource m Double+sourceVocoderWithPhase iphs src = AudioSource newSource (rateV src) (channelsV src) (framesV src)+ where+ par = vocoderParamsV src+ phs = ZipList $ replicate (channelsV src) iphs+ newSource = (sourceV src (V.empty, (phs, phs)) >> return ())+ .| sumFramesE (chunkSize * channelsV src) (vocHopSize par * channelsV src)++-- | Applies a conduit filter to an audio stream.+processAudio + :: Monad m+ => VocoderParams+ -> Filter m+ -> AudioSource m Double + -> AudioSource m Double+processAudio par = processAudioWithPhase par (zeroPhase par)++-- | Applies a conduit filter to an audio stream, with initial phase provided.+processAudioWithPhase+ :: Monad m+ => VocoderParams+ -> Phase+ -> Filter m+ -> AudioSource m Double + -> AudioSource m Double+processAudioWithPhase par iphs c src = sourceVocoderWithPhase iphs $ processVocoderAudio par c src+++
+ vocoder-audio.cabal view
@@ -0,0 +1,62 @@+name: vocoder-audio+version: 0.1.0.0+homepage: https://github.com/tilk/vocoder+synopsis: Phase vocoder for conduit-audio+description:+ This module allows to easily use frequency domain processing on audio+ streams created by @conduit-audio@.+license: BSD2+license-file: LICENSE+author: Marek Materzok+maintainer: tilk@tilk.eu+-- copyright:+category: Sound+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++flag buildExamples+ description: Build example executables+ default: False++library+ exposed-modules: Vocoder.Audio+ -- other-modules:+ -- other-extensions:+ build-depends: base >=4.11 && <4.15,+ vector >= 0.12.1.0 && <0.13,+ vector-fftw >= 0.1.3.8 && < 0.2,+ conduit >= 1.3.2 && < 1.4,+ vocoder >= 0.1.0.0 && < 0.2,+ vocoder-conduit >= 0.1.0.0 && < 0.2,+ containers >= 0.6.3.1 && < 0.7,+ mono-traversable >= 1.0.15.1 && < 1.1,+ conduit-audio >= 0.2.0.3 && < 0.3+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++executable vocoder-file+ main-is: VocoderFile.hs+ hs-source-dirs: example+ -- other-modules:+ if flag(buildExamples)+ build-depends: base,+ vector,+ conduit,+ vocoder,+ vocoder-conduit,+ vocoder-audio,+ hsndfile >= 0.8.0 && < 0.9,+ conduit-audio,+ conduit-audio-sndfile >= 0.1.2.2 && < 0.2,+ resourcet >= 1.2.2 && < 1.3,+ optparse-applicative >= 0.16.0.0 && < 0.17,+ split >= 0.2.3.4 && < 0.3,+ random >= 1.2.0 && < 1.3+ else+ buildable: False+ default-language: Haskell2010+ ghc-options: -Wall++