module Sox where import qualified Named import qualified Parameters as Params import qualified Signal import qualified Rate import qualified Option import qualified Synthesizer.Basic.Binary as Bin import qualified Sound.SoxLib as SoxLib import qualified Data.StorableVector.Lazy as SVL import Foreign.Storable (peek) import Control.Monad (when) import Control.Applicative ((<$>)) import qualified Data.List as List import Data.Maybe (fromMaybe) import qualified System.Path.PartClass as PathClass import qualified System.Path.IO as PathIO import qualified System.Path as Path import Text.Printf (printf) import qualified Algebra.RealRing as Real import Data.Int (Int32) withSound :: (PathClass.AbsRel ar) => Option.Flags -> Path.FilePath ar -> (SoxLib.Format SoxLib.ReadMode -> Signal.Sox -> IO b) -> IO b withSound flags path act = SoxLib.withRead SoxLib.defaultReaderInfo (Path.toString path) $ \fmtPtr -> do fmt <- peek fmtPtr let numChan = fromMaybe 1 $ SoxLib.channels $ SoxLib.signalInfo fmt rate = case Option.sampleRate flags of Just r -> Rate.Sample r Nothing -> case SoxLib.rate $ SoxLib.signalInfo fmt of Just r -> Rate.Sample r Nothing -> Params.sampleRate Params.deflt when (numChan/=1) $ ioError $ userError $ printf "expected mono file but got %d channels" numChan act fmt . Signal.Cons rate =<< SoxLib.readStorableVectorLazy fmtPtr (case Option.chunkSize flags of SVL.ChunkSize size -> SVL.ChunkSize $ numChan * size) multiInfoFromFormat :: (Rate.C rate) => Int -> SoxLib.Format mode -> rate -> SoxLib.WriterInfo multiInfoFromFormat numChannels fmtIn rate = SoxLib.defaultWriterInfo { SoxLib.writerSignalInfo = Just $ (SoxLib.signalInfo fmtIn) { SoxLib.channels = Just numChannels, SoxLib.length = (numChannels *) <$> SoxLib.length (SoxLib.signalInfo fmtIn), SoxLib.rate = Just $ Rate.unpack rate } } writerInfoFromFormat :: (Rate.C rate) => SoxLib.Format mode -> rate -> SoxLib.WriterInfo writerInfoFromFormat fmtIn rate = SoxLib.defaultWriterInfo { SoxLib.writerSignalInfo = Just $ (SoxLib.signalInfo fmtIn) { SoxLib.rate = Just $ Rate.unpack rate } } writeChannels :: (Rate.C rate, PathClass.AbsRel ar) => SoxLib.Format mode -> rate -> Path.FilePath ar -> [SVL.Vector Int32] -> IO () writeChannels fmtIn rate output sigs = SoxLib.withWrite (multiInfoFromFormat (length sigs) fmtIn rate) (Path.toString output) $ \fmtOut -> SoxLib.writeStorableVectorLazy fmtOut $ SVL.interleaveFirstPattern sigs writeFeatures :: (Rate.C rate, PathClass.AbsRel ar) => SoxLib.Format mode -> Path.FilePath ar -> [Float] -> Signal.T rate [Named.Signal] -> IO () writeFeatures fmtIn output scales (Signal.Cons rate featSigs) = writeChannels fmtIn rate output $ zipWith (\c -> SVL.map (Bin.fromCanonicalWith Real.roundSimple . (c*)) . Named.body) scales featSigs _writeFeatures :: (Rate.C rate, PathClass.AbsRel ar) => SoxLib.Format mode -> Path.FilePath ar -> [Float] -> Signal.T rate [Named.Signal] -> IO () _writeFeatures _fmtIn output _scales (Signal.Cons rate featSigs) = PathIO.writeFile (Path.replaceExtension output "dat") $ unlines $ show (Rate.unpack rate) : (map (unwords . map show) $ List.transpose $ map (SVL.unpack . Named.body) featSigs)