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"