first python ana version

2022-09-08 19:55:09 +02:00
commit 01eb9272a3
15 changed files with 931 additions and 0 deletions
@@ -0,0 +1,97 @@
+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"