classify-frog-0.2.3: src/Sox.hs

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)