autocut/app/Main.hs

module Main (main) where

import Lib
import Parser
import Driver
import Types

runDehum :: Flags -> FilePath -> FilePath -> IO ()
runDehum flags input output =
   withSound flags input $ \fmtIn params sig ->
   SoxLib.withWrite
      (writerInfoFromFormat fmtIn params)
      output $ \fmtOut ->
         SoxLib.writeStorableVectorLazy fmtOut $
         SVL.interleaveFirstPattern $
         map
            (Causal.apply
               (arr (Bin.fromCanonicalWith Real.roundSimple)
                <<<
                dehum params
                <<<
                arr Bin.toCanonical)) $
         SVL.deinterleave (numChannels params) sig

runEnvelope :: Flags -> FilePath -> FilePath -> IO ()
runEnvelope flags input output =
   withSound flags input $ \fmtIn params sig ->
   SoxLib.withWrite
      (monoInfoFromFormat fmtIn params)
      output $ \fmtOut ->
         SoxLib.writeStorableVectorLazy fmtOut $
         Causal.apply
            (arr (Bin.fromCanonicalWith Real.roundSimple)) $
         trackEnvelope params $
         map
            (Causal.apply
               (arr (^2)
                <<<
                dehum params
                <<<
                arr Bin.toCanonical)) $
         SVL.deinterleave (numChannels params) sig

runSizes :: Flags -> FilePath -> IO ()
runSizes flags input =
   withSound flags input $ \_fmt params sig ->
   mapM_ print $ pieceDurations params sig

runLabels :: Flags -> FilePath -> IO ()
runLabels flags input =
   withSound flags input $ \_fmt params sig ->
   mapM_ (\(n, (from,to)) -> printf "%s\t%s\t%d\n" from to n) $
   zip [(0::Int) ..] $
   ListHT.mapAdjacent (,) $
   map (\t ->
      case divMod (Real.roundSimple (fromIntegral t * 10^6 / sampleRate params)) (10^6) of
         -- FIXME: the comma is certainly only correct in German locale
         (seconds,micros) ->
            printf "%d,%06d" seconds (micros::Integer) :: String) $
   scanl (+) 0 $
   prefetch (preStart params) $
   pieceDurations params sig

{- |
> runChop flags "in.wav" "%03d.wav"
-}
runChop :: Flags -> FilePath -> FilePath -> IO ()
runChop flags input output =
   withSound flags input $ \fmtIn params sig ->
   forM_ (zip [(0::Int)..] $ chopLazy params sig) $ \(n,piece) ->
      SoxLib.withWrite
         (writerInfoFromFormat fmtIn params)
         (printf output n) $ \fmtOut ->
            SoxLib.writeStorableVectorLazy fmtOut piece

main :: IO ()
main = SoxLib.formatWith $ do
   argv <- getArgs
   let (opts, files, errors) =
          getOpt Opt.RequireOrder description argv
   when (not $ null errors) $
      exitFailureMsg (init (concat errors))

   flags <- foldl (>>=) (return defltFlags) opts

   if flagComputeEnvelope flags
     then
       case files of
          [input,output] -> runEnvelope flags input output
          [] -> exitFailureMsg "need input and output file envelope computation"
          _ -> exitFailureMsg "more than two file names given"
     else
       case files of
          [input,output] -> runChop flags input output
          [input] -> runLabels flags input
          [] -> exitFailureMsg "no input or output given"
          _ -> exitFailureMsg "more than two file names given"