diff options
author | OleksandrZhabenko <> | 2021-01-13 19:20:00 (GMT) |
---|---|---|
committer | hdiff <hdiff@hdiff.luite.com> | 2021-01-13 19:20:00 (GMT) |
commit | aa5ac94a296ba02522bf1847992980b8dd39a658 (patch) | |
tree | 01a14e026fbd06af66dbd85c49418763fe9cc3d1 |
version 0.1.0.00.1.0.0
-rw-r--r-- | ChangeLog.md | 7 | ||||
-rw-r--r-- | LICENSE | 20 | ||||
-rw-r--r-- | Parser/ReplaceP.hs | 38 | ||||
-rw-r--r-- | README.markdown | 2 | ||||
-rw-r--r-- | Setup.hs | 2 | ||||
-rw-r--r-- | Sound/Control/Exception/FinalException.hs | 63 | ||||
-rw-r--r-- | Sound/SoXBasics.hs | 599 | ||||
-rw-r--r-- | Sound/SoXBasics1.hs | 291 | ||||
-rw-r--r-- | mmsyn7ukr-common.cabal | 25 |
9 files changed, 1047 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..a1889bf --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,7 @@ +# Revision history for mmsyn7ukr-common + +## 0.1.0.0 -- 2021-01-13 + +* First version. Released on an unsuspecting world. Code is taken from the +mmsyn7ukr package that is intended to be replaced by the new mmsyn7ukr-array package. +Is provided for backward compatibility for mmsyn7ukr. @@ -0,0 +1,20 @@ +Copyright (c) 2019 OleksandrZhabenko + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Parser/ReplaceP.hs b/Parser/ReplaceP.hs new file mode 100644 index 0000000..c8c4d92 --- /dev/null +++ b/Parser/ReplaceP.hs @@ -0,0 +1,38 @@ +-- | +-- Module : Parser.ReplaceP +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- This module provides some basic parsing functions for some special used 'Show' representation. +-- + +module Parser.ReplaceP where + +-- | Function is used internally to parse a given third command line argument as a @[String]@ representing the Ukrainian sounds, which will be produced. +replaceP :: String -> String +replaceP (x:y:z:u:v:xs) + | x == '[' && y == '\"' && z == '[' && u == '\\' && v == '\\' = "[\"\\" ++ replaceP xs + | x == ',' && y == '\\' && z == '\\' = "\",\"\\" ++ replaceP (u:v:xs) + | x == ']' && y == '\"' && z == ']' = "\"]" ++ replaceP (u:v:xs) + | otherwise = x:replaceP (y:z:u:v:xs) +replaceP (x:y:z:u:xs) + | x == ',' && y == '\\' && z == '\\' = "\",\"\\" ++ replaceP (u:xs) + | x == ']' && y == '\"' && z == ']' = "\"]" ++ replaceP (u:xs) + | otherwise = x:replaceP (y:z:u:xs) +replaceP (x:y:z:xs) + | x == ',' && y == '\\' && z == '\\' = "\",\"\\" ++ replaceP xs + | x == ']' && y == '\"' && z == ']' = "\"]" ++ replaceP xs + | otherwise = x:replaceP (y:z:xs) +replaceP xs = xs + +-- | Function is used internally to parse further the result dealt with 'replaceP' function. +replaceP4 :: String -> String +replaceP4 (t:x:y:z:u:v:xs) + | [t,x,y,z,u,v] == "\\\\1078" = '\1078':replaceP4 xs + | [t,x,y,z,u,v] == "\\\\1079" = '\1079':replaceP4 xs + | [t,x,y,z,u,v] == "\\\\1100" = '\1100':replaceP4 xs + | otherwise = t:replaceP4 (x:y:z:u:v:xs) +replaceP4 (x:xs) = x:replaceP4 xs +replaceP4 [] = [] diff --git a/README.markdown b/README.markdown new file mode 100644 index 0000000..c0a7a7b --- /dev/null +++ b/README.markdown @@ -0,0 +1,2 @@ +Some SoX wrappered functionality that can be used further (e. g. by +mmsyn7ukr and mmsyn7ukr-array packages). diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Sound/Control/Exception/FinalException.hs b/Sound/Control/Exception/FinalException.hs new file mode 100644 index 0000000..87c0faf --- /dev/null +++ b/Sound/Control/Exception/FinalException.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Sound.Control.Exception.FinalException +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Exceptions for the other modules. +-- + +module Sound.Control.Exception.FinalException ( + FinalException(..) + -- * Exception + , catchEnd +) where + +import Data.Typeable +import Control.Exception (Exception, catch, throw) +import System.Environment (getProgName) +import System.IO +import GHC.IO.Handle.Types (Newline( CRLF ), nativeNewline) + +-- | Data type 'FinalException' is used to terminate the not needed further execution. +data FinalException = ExecutableNotProperlyInstalled | MaybePartiallyTrimmed | NotCreatedWithEffect String + | InitialFileNotChanged String | NotCreated String | NotRecorded String | NoiseProfileNotCreatedB String | NoiseProfileNotCreatedE String + | NotEnoughData String | NotCreatedWithEffects String | StrangeAnswer String String | NotFileNameGiven | DataFileNotClosed String + | DataSoundFileNotRead String | UndefinedFunction String + deriving ( Typeable ) + +instance Exception FinalException + +instance Show FinalException where + show ExecutableNotProperlyInstalled = "Sound.Control.Exception.FinalException.ExecutableNotProperlyInstalled: SoX is not properly installed in your system. Please, install it properly and then call the function again." ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show MaybePartiallyTrimmed = "Sound.Control.Exception.FinalException.MaybePartiallyTrimmed: The function did not create the needed file, but may be it trimmed the initial one (not enough)!" + ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (NotCreatedWithEffect xs) = "Sound.Control.Exception.FinalException.NotCreatedWithEffect: File was not created with " ++ show xs ++ " effect!" ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (InitialFileNotChanged xs) = "Sound.Control.Exception.FinalException.InitialFileNotChanged: The initial file " ++ show xs ++ " was not changed!" ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (NotCreated xs) = "Sound.Control.Exception.FinalException.NotCreated: The function did not create the needed file " ++ show xs ++ "!" ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (NotRecorded xs) = "Sound.Control.Exception.FinalException.NotRecorded: The file " ++ show xs ++ " was not recorded!" ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (NoiseProfileNotCreatedB xs) = "Sound.Control.Exception.FinalException.NoiseProfileNotCreatedB: The noise profile " ++ xs ++ ".b.prof was not created!" + ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (NoiseProfileNotCreatedE xs) = "Sound.Control.Exception.FinalException.NoiseProfileNotCreatedE: The noise profile " ++ xs ++ ".e.prof was not created!" + ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (NotEnoughData xs) = "Sound.Control.Exception.FinalException.NotEnoughData: SoX cannot determine the number of the samples in the file " ++ show xs ++ + "! May be it is a RAW file and it needs additional parameters to be processed." ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (NotCreatedWithEffects xs) = "Sound.Control.Exception.FinalException.NotCreatedWithEffects: File was not created with " ++ (init . unwords . map ((++ ",") . show) . words $ xs) ++ " effects!" + ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (StrangeAnswer xs ys) = xs ++ ": the " ++ show ys ++ " function gave a strange result!" ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show NotFileNameGiven = "Please, specify as a command line argument at least a name of the resulting file (without its extension)! " + ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (DataFileNotClosed xs) = "File " ++ show xs ++ " is not closed!" ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (DataSoundFileNotRead xs) = "Data sound file " ++ show xs ++ " is not read!" ++ (if nativeNewline == CRLF then "\r\n" else "\n") + show (UndefinedFunction xs) = xs ++ ": the function is undefined for the arguments. " ++ (if nativeNewline == CRLF then "\r\n" else "\n") + +-- | Function to work with exception 'FinalException' similarly to the example in the documentation for the 'catch' function. It throws an exception +-- to the thread where it is called. +catchEnd :: FinalException -> IO () +catchEnd e = do + progName <- getProgName + catch (throw e) (\e0 -> hPutStr stderr (progName ++ ": " ++ show (e0 :: FinalException))) diff --git a/Sound/SoXBasics.hs b/Sound/SoXBasics.hs new file mode 100644 index 0000000..c88ab75 --- /dev/null +++ b/Sound/SoXBasics.hs @@ -0,0 +1,599 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Sound.SoXBasics +-- Copyright : (c) OleksandrZhabenko 2019-2021 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- A program and a library that can be used as a simple basic interface to some SoX functionality. +-- + + +module Sound.SoXBasics ( + -- * Encoding file extensions and types functional data type + ULencode(..) + , SoundFileExts(..) + -- * Working with two extensions + , soxOpG, soxOpG1, ulAccessParameters, ulResultParameters + -- * Some generalized common functions + , doubleCleanCheck, presenseCheck, secondFileClean, twoIntermediateFs, twoExceptions1File, applyExts2, beforeExtStr + -- * Get Information + , maxAbs, getMaxAG, getMinAG, selMaxAbsG, selMAG, extremeSG, extremeSG1G, soxStatG, upperBndG, durationAG, sampleAnG + -- * Produce sound + -- ** Trimming the silence + , alterVadBG, alterVadEG, alterVadHelpG, opFileG + -- ** Amplitude modification + , normG, normLG, gainLG, quarterSinFadeG + -- ** Adding silence + , silenceBothG + -- ** Changing sample rate + , resampleAG + -- ** Working with noise + , noiseProfBG, noiseProfEG, noiseReduceBG, noiseReduceEG, noiseReduceBUG, noiseReduceEUG + -- ** Filtering + , sincAG + -- ** Volume amplification + , volSG, volS2G + -- * Variants that uses just .wav files + , getMaxA, getMinA, selMaxAbs, selMA, extremeS, extremeS1, soxStat, upperBnd, durationA, sampleAn + , alterVadB, alterVadE, alterVadHelp, opFile + , norm, normL, gainL, quarterSinFade + , silenceBoth + , resampleA + , noiseProfB, noiseProfE, noiseReduceB, noiseReduceE, noiseReduceBU, noiseReduceEU + , sincA + , volS, volS2 +) where + +import System.Directory +import Data.Maybe (isJust, fromJust) +import Data.List (isSuffixOf) +import Numeric +import Data.Char +import System.Process +import System.IO +import EndOfExe +import System.Exit +import Control.Concurrent (threadDelay) +import Control.Exception (onException) +import System.Info (os) +import Sound.Control.Exception.FinalException + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__>=710 +/* code that applies only to GHC 7.10.* and higher versions */ +import GHC.Base (mconcat) +#endif +#endif +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +-- | Function 'maxAbs' allows to choose a maximum by absolute value if the values are written as 'String'. Bool 'True' corresponds to maximum value, 'False' - to minimum value +maxAbs :: (String, String) -> (String, Bool) +maxAbs (xs, ys) | null xs || null ys = ([], False) + | head xs == '-' && head ys == '-' = if compare xs ys /= LT then (xs, False) else (ys, False) + | head xs /= '-' && head ys /= '-' = if compare xs ys == GT then (xs, True) else (ys, True) + | head xs == '-' && head ys /= '-' = if compare (tail xs) ys /= LT then (xs, False) else (ys, True) + | otherwise = if compare xs (tail ys) == GT then (xs, True) else (ys, False) + +ulAccessParameters :: [String] +ulAccessParameters = ["-r22050","-c1"] + +ulResultParameters :: [String] +ulResultParameters = ["-r22050","-c1"] + +data ULencode = W | UL1 | UL0 | UL deriving (Eq, Ord) + +instance Show ULencode where + show W = "(False, False)" -- Only working with .wav files. + show UL1 = "(False, True)" -- .ul appears. + show UL0 = "(True, False)" -- .ul disappears. + show _ = "(True, True)" -- .ul is constantly used. + +class SoundFileExts a where + getExts :: a -> (String,String) + isFileExtsR :: a -> FilePath -> FilePath -> Bool + isFileExtsR ul file1 file2 = xs `isSuffixOf` file1 && ys `isSuffixOf` file2 + where (xs,ys) = getExts ul + +instance SoundFileExts ULencode where + getExts W = (".wav",".wav") + getExts UL1 = (".wav",".ul") + getExts UL0 = (".ul",".wav") + getExts _ = (".ul",".ul") + +-- | Is partially defined, is used internally here. +applyExts2 :: ULencode -> FilePath -> FilePath -> (FilePath, FilePath) +applyExts2 ul file1 file2 = (beforeExtStr file1 ++ xs, beforeExtStr file2 ++ ys) + where (xs,ys) = getExts ul + +beforeExtStr :: FilePath -> String +beforeExtStr file = + case end of + ".wav" -> begin + (z:".ul") -> begin ++ [z] + _ -> error "Sound.SoXBasics.beforeExtStr: The file has neither .wav, nor .ul extension." + where l = length file - 4 + (begin,end) = splitAt l file + +-- | The 'FilePath' cannot be \"-n\", please, use in such a case a more convinient function 'soxOpG1'. +soxOpG :: ULencode -> [String] -> FilePath -> [String] -> FilePath -> [String] -> IO (ExitCode, String, String) +soxOpG ul xss file1 yss file2 zss + | isFileExtsR ul file1 file2 = readProcessWithExitCode (fromJust (showE "sox")) (filter (not . null) . mconcat $ + case ul of { W -> [xss, [file10], yss, [file20], zss] ; UL1 -> [xss, [file10], yss, ulResultParameters, [file20], zss] ; UL0 -> [xss, ulAccessParameters, [file10], yss, [file20], zss] ; ~bbb -> [xss, ulAccessParameters, [file10], yss, ulResultParameters, [file20], zss] }) "" + | otherwise = error "Sound.SoXBasics.soxOpG: At least one of the two given files has inappropriate file extension. Please, check the arguments. " + where (file10, file20) = applyExts2 ul file1 file2 + +-- | The variant of the 'soxOpG' that is used if the second file is not used (or in the situation where some +-- other file is used, too, e. g. with the .prof extension). For the functions in the module, this corresponds +-- to the \"-n\" second file argument. +soxOpG1 :: ULencode -> [String] -> FilePath -> [String] -> [String] -> IO (ExitCode, String, String) +soxOpG1 ul xss file1 yss zss + | (fst . getExts $ ul) `isSuffixOf` file1 = + if ul < UL0 then readProcessWithExitCode (fromJust (showE "sox")) (filter (not . null) . mconcat $ + [xss, [file1], yss, ["-n"], zss]) "" + else readProcessWithExitCode (fromJust (showE "sox")) (filter (not . null) . mconcat $ + [xss, ulAccessParameters, [file1], yss, ["-n"], zss]) "" + | otherwise = error "Sound.SoXBasics.soxOpG1: A given file has inappropriate file extension. Please, check the arguments. " + +-- | Function 'getMaxAG' returns a maximum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of 'Int' values. +getMaxAG :: ULencode -> FilePath -> (Int, Int) -> IO String +getMaxAG ul file (lowerbound, upperbound) = if isJust (showE "sox") + then do + (_, _, herr) <- soxOpG1 ul [] file [] ["trim", show lowerbound ++ "s", "=" ++ show upperbound ++ "s", "stat"] + let zs = lines herr in return (let u = (words $ zs !! 3) !! 2 in if head u == '-' then take 9 u else take 8 u) + else do + catchEnd ExecutableNotProperlyInstalled + return [] + +-- | Function 'getMinAG' returns a minimum amplitude of the sound in the file in the given lower and upper bounds represented as a tuple of 'Int' values. +getMinAG :: ULencode -> FilePath -> (Int, Int) -> IO String +getMinAG ul file (lowerbound, upperbound) = if isJust (showE "sox") + then do + (_, _, herr1) <- soxOpG1 ul [] file [] ["trim", show lowerbound ++ "s", "=" ++ show upperbound ++ "s", "stat"] + let zs = lines herr1 in return (let u = (words $ zs !! 4) !! 2 in if head u == '-' then take 9 u else take 8 u) + else do + catchEnd ExecutableNotProperlyInstalled + return [] + +-- | Function 'selMaxAbsG' returns a maximum by absolute value amplitude of the sound and allows by its second value in the tuple determine whether it is a maximum or minimum. +-- Bool 'True' corresponds to maximum value, 'False' - to minimum value. +selMaxAbsG :: ULencode -> FilePath -> (Int, Int) -> IO (String, Bool) +selMaxAbsG ul file (lowerbnd, upperbnd) = do + tX <- getMaxAG ul file (lowerbnd, upperbnd) + tN <- getMinAG ul file (lowerbnd, upperbnd) + return (maxAbs (tX, tN)) + +-- | Function 'selMAG' returns a maximum or a minimum of the sound amplitude of the file depending on the @Bool@ value given. +-- Bool 'True' corresponds to maximum value, 'False' - to minimum value. +selMAG :: ULencode -> FilePath -> (Int, Int) -> Bool -> IO String +selMAG ul file (lowerbnd, upperbnd) x = if x then getMaxAG ul file (lowerbnd, upperbnd) else getMinAG ul file (lowerbnd, upperbnd) + +-- | Function 'extremeSG' returns an approximate sample number of the extremum, which will be used further for fade effect. +extremeSG :: ULencode -> FilePath -> (Int, Int) -> Int -> IO (String, Bool) -> IO Int +extremeSG ul file (lowerbnd, upperbnd) eps x = if compare (upperbnd - lowerbnd) (eps + 33) == LT + then return $ (upperbnd + lowerbnd) `quot` 2 + else do + (ys, z) <- x + let t = (lowerbnd + upperbnd) `quot` 2 + rs <- selMAG ul file (lowerbnd, t) z + if (ys == rs) + then extremeSG ul file (lowerbnd, t) eps x + else extremeSG ul file (t, upperbnd) eps x + +-- | Function 'alterVadBG' removes an approximate silence measured by the absolute value of the sound amplitude from the beginning of the file. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). The file must have maximum amplitude absolute value close to 1 before call to the 'alterVadBG'. +-- The second @Float@ parameter is used to exit the iteration cycle. The 'Int' parameter from the range [0..3] specifies a maximum amplitude, starting from +-- which the sound will not be trimmed. +alterVadBG :: ULencode -> FilePath -> Float -> Int -> Float -> IO () +alterVadBG ul file lim noiseMax exit + | compare lim exit /= GT = putStrLn $ "File " ++ file ++ " is ready for further processing." + | otherwise = + if isJust (showE "sox") + then do + lim1 <- durationAG ul file + alterVadHelpG ul file lim1 lim noiseMax exit + else catchEnd ExecutableNotProperlyInstalled + +doubleCleanCheck :: FilePath -> FinalException -> IO () +doubleCleanCheck file exception = do + e0 <- doesFileExist file + if e0 then removeFile file >> catchEnd exception else catchEnd exception + +-- | Function 'alterVadHelpG' is used internally in the 'alterVadBG' and 'alterVadEG' functions. +alterVadHelpG :: ULencode -> FilePath -> Float -> Float -> Int -> Float -> IO () +alterVadHelpG ul file lim1 lim noiseMax exit + | compare lim1 lim == LT = alterVadBG ul file lim1 noiseMax exit + | compare lim1 lim == EQ = + let noiseM = (case noiseMax of + 0 -> "0.01" + 1 -> "0.02" + 2 -> "0.04" + 3 -> "0.08" + _ -> "0.04") in do + (_, _, herr) <- soxOpG1 ul [] file [] ["trim", "0", showFFloat Nothing (lim1 / 2.0) $ show 0, "stat"] + let zs = lines herr in let z = concatMap (dropWhile (not . isDigit)) . take 1 . drop 3 $ zs in if z < noiseM + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["trim", showFFloat Nothing (lim1 / 2.0) $ show 0, "-0.000000"] + if code == ExitSuccess then threadDelay 100000 >> opFileG ul file10 file20 exit noiseMax + else doubleCleanCheck file20 MaybePartiallyTrimmed + else alterVadBG ul file10 (lim1 / 4.0) noiseMax exit + | otherwise = + let noiseM = (case noiseMax of + 0 -> "0.01" + 1 -> "0.02" + 2 -> "0.04" + 3 -> "0.08" + _ -> "0.04") in do + (_, _, herr) <- soxOpG1 ul [] file [] ["trim", "0", showFFloat Nothing (lim / 2.0) $ show 0, "stat"] + let zs = lines herr in let z = concatMap (dropWhile (not . isDigit)) . take 1 . drop 3 $ zs in if z < noiseM + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["trim", showFFloat Nothing (lim / 2.0) $ show 0, "-0.000000"] + if code == ExitSuccess then threadDelay 100000 >> opFileG ul file10 file20 exit noiseMax + else doubleCleanCheck file20 MaybePartiallyTrimmed + else alterVadBG ul file10 (lim / 4.0) noiseMax exit + where (file10, file20) = applyExts2 ul file ("7" ++ file) + +-- | Function 'opFileG' is used internally in 'alterVadB' to check whether 'FilePath' exist and if so to do some processing to allow the 'alterVadB' function iterate further. +opFileG :: ULencode -> FilePath -> FilePath -> Float -> Int -> IO () +opFileG ul file1 file2 exit noiseMax = do + removeFile file1 + exist0 <- doesFileExist file1 + if exist0 + then opFileG ul file1 file2 exit noiseMax + else do + renameFile file2 file1 + lim2 <- durationAG ul file1 + alterVadBG ul file1 lim2 noiseMax exit + +presenseCheck :: FilePath -> FinalException -> IO () +presenseCheck file exception = do + e2 <- doesFileExist file + if e2 then return () else catchEnd exception + +twoExceptions1File :: ExitCode -> FilePath -> FinalException -> FinalException -> IO () +twoExceptions1File code file exc1 exc2 = + if code /= ExitSuccess then doubleCleanCheck file exc1 else presenseCheck file exc2 + +-- | Function 'norm' applies a SoX normalization effect on the audio file. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +normG :: ULencode -> FilePath -> IO () +normG ul file = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["norm"] + twoExceptions1File code file20 (NotCreatedWithEffect "norm") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("8" ++ file) + +-- | Function 'normLG' applies a SoX gain effect on the audio file with the maximum absolute dB value given by the 'Int' argument. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +normLG :: ULencode -> FilePath -> Int -> IO () +normLG ul file level = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["gain", "-n", show level] + twoExceptions1File code file20 (NotCreatedWithEffect "gain -n") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("9" ++ file) + +-- | Function 'normLG' applies a SoX \"gain -b [db-Value]\" effect on the audio file with dB value given by the @Float@ argument. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +gainLG :: ULencode -> FilePath -> Float -> IO () +gainLG ul file level = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["gain", "-b", showFFloat (Just 6) level $ show 0] + twoExceptions1File code file20 (NotCreatedWithEffect "gain -b") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("9" ++ file) + +-- | Function 'soxStatG' prints a SoX statistics for the audio file. +soxStatG :: ULencode -> FilePath -> IO () +soxStatG ul file = if isJust (showE "sox") + then do + (_, _, herr) <- soxOpG1 ul [] file [] ["stat"] + putStrLn herr + else catchEnd ExecutableNotProperlyInstalled + +secondFileClean :: FilePath -> FilePath -> FinalException -> IO () +secondFileClean file1 file2 exception = do + e1 <- doesFileExist file2 + if e1 then removeFile file2 else putStr "" + removeFile file1 + catchEnd exception + +twoIntermediateFs :: ExitCode -> FilePath -> FilePath -> FilePath -> FinalException -> IO () +twoIntermediateFs code file1 file2 file3 exception = do + if code /= ExitSuccess + then secondFileClean file1 file2 exception + else do + e2 <- doesFileExist file2 + if e2 + then do + removeFile file1 + removeFile file3 + renameFile file2 file3 + else do + removeFile file1 + catchEnd exception + +-- | Function 'alterVadE' removes an approximate silence measured by the absolute value of the sound amplitude from the end of the file. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). The second @Float@ parameter is used to exit the iteration cycle. The 'Int' parameter +-- from the range [0..3] specifies a maximum amplitude, starting from which the sound will not be trimmed. +alterVadEG :: ULencode -> FilePath -> Float -> Int -> Float -> IO () +alterVadEG ul file lim noiseMax exit + | compare lim exit /= GT = putStrLn $ "File " ++ file ++ " is ready for further processing" + | otherwise = + if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["reverse"] + if code /= ExitSuccess + then doubleCleanCheck file20 (NotCreated file10) + else do + alterVadBG ul file20 lim noiseMax exit + (code1, _, _) <- soxOpG ul [] file30 [] file40 ["reverse"] + twoIntermediateFs code1 file20 file40 file10 (NotCreated file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("6" ++ file) + (file30, file40) = applyExts2 ul file20 ("76" ++ file10) + +-- | Function 'upperBndG' returns a maximum number of samples for use in other functions. +upperBndG :: ULencode -> FilePath -> IO Int +upperBndG ul file = if isJust (showE "soxi") + then do { + (_, Just hout, _, _) <- createProcess (proc (fromJust (showE "soxi")) (if ul < UL0 then ["-s",file] else mconcat [["-s"],ulAccessParameters,[file]])){ std_out = CreatePipe } ; + x0 <- hGetContents hout ; + let z = read x0::Int in return z } + else catchEnd ExecutableNotProperlyInstalled >> return (0::Int) + +-- | Variant of the function 'extremeSG' with all the additional information included. +extremeSG1G :: ULencode -> FilePath -> IO Int +extremeSG1G ul file = do + upp <- upperBndG ul file + extremeSG ul file (0::Int, upp) (if upp `quot` 32 > 2 then upp `quot` 32 else 2::Int) (selMaxAbsG ul file (0::Int, upp)) + +-- | Function 'quarterSinFadeG' applies a fade effect by SoX to the audio file with \"q\" type. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +quarterSinFadeG :: ULencode -> FilePath -> IO () +quarterSinFadeG ul file = if isJust (showE "sox") + then do + pos <- extremeSG1G ul file + upp <- upperBndG ul file + (code, _, _) <- soxOpG ul [] file10 [] file20 ["fade", "q", show pos ++ "s", "=" ++ show upp ++ "s", show (upp - pos) ++ "s"] + twoExceptions1File code file20 (NotCreatedWithEffect "fade q") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("4" ++ file) + +-- | Function 'silenceBothG' adds some silence to both ends of the audio. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +silenceBothG :: ULencode -> FilePath -> Int -> Int -> IO () +silenceBothG ul file beginning end = if isJust (showE "sox") + then do + _ <- soxOpG ul [] file10 [] file20 ["delay", show beginning ++ "s", "reverse"] + _ <- soxOpG ul [] file20 [] file40 ["delay", show end ++ "s", "reverse"] + removeFile file20 + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("3" ++ file) + (file30, file40) = applyExts2 ul file20 ("2" ++ file10) + +-- | Function 'resampleAG' changes the sample rate for the recorded audio for further processing. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +resampleAG :: ULencode -> FilePath -> Int -> IO () +resampleAG ul file frequency = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["rate", "-s", "-I", show frequency] + twoExceptions1File code file20 (NotCreatedWithEffect "rate") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("3" ++ file) + +-- | Function 'durationAG' returns a duration of the audio file in seconds. +durationAG :: ULencode -> FilePath -> IO Float +durationAG ul file = if isJust (showE "soxi") + then do + (_, Just hout, _, _) <- createProcess (proc (fromJust (showE "soxi")) (if ul < UL0 then ["-D",file] else mconcat [["-D"],ulAccessParameters,[file]])) { std_out = CreatePipe } + x0 <- hGetContents hout + let z = read x0::Float in return z + else catchEnd ExecutableNotProperlyInstalled >> return 0.0 + +-- | Function 'noiseProfBG' creates with SoX a file containing a noise profile for the first 0.05 s of the audio file given. +noiseProfBG :: ULencode -> FilePath -> IO () +noiseProfBG ul file = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG1 ul [] file [] ["trim", "0", "0.05", "noiseprof",file ++ ".b.prof"] + twoExceptions1File code (file ++ ".b.prof") (NoiseProfileNotCreatedB file) (NoiseProfileNotCreatedB file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'noiseProfEG' creates with SoX a file containing a noise profile for the last 0.05 s of the audio file given. +noiseProfEG :: ULencode -> FilePath -> IO () +noiseProfEG ul file = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG1 ul [] file [] ["trim", "-0.05", "0.05", "noiseprof",file ++ ".e.prof"] + twoExceptions1File code (file ++ ".e.prof") (NoiseProfileNotCreatedE file) (NoiseProfileNotCreatedE file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'noiseReduceBG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfBG' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +noiseReduceBG :: ULencode -> FilePath -> IO () +noiseReduceBG ul file = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["noisered", file10 ++ ".b.prof"] + twoExceptions1File code file20 (NotCreatedWithEffect "noisered") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("_" ++ file) + +-- | Function 'noiseReduceEG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfEG' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +noiseReduceEG :: ULencode -> FilePath -> IO () +noiseReduceEG ul file = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["noisered", file10 ++ ".e.prof"] + twoExceptions1File code file20 (NotCreatedWithEffect "noisered") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("_." ++ file) + +-- | Function 'noiseReduceBUG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfBUG' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). The @Float@ parameter is a number between 0 and 1 showing the level of +-- reducing the noise (the greater number means that the function will reduce more intensively may be even aggressively so that for greater +-- numbers it can remove some sensitive and important sound data as a noise). Internally this parameter is passed unchanged to the \"sox\" +-- so that it uses it as an amount parameter for the \"noisered\" effect. Therefore, please, (as being stated in the SoX manual) experiment +-- with the amount to get suitable results. +noiseReduceBUG :: ULencode -> FilePath -> Float -> IO () +noiseReduceBUG ul file amount = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["noisered", file10 ++ ".b.prof", showFFloat (Just 4) amount $ show 0] + twoExceptions1File code file20 (NotCreatedWithEffect "noisered") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("_" ++ file) + +-- | Function 'noiseReduceEUG' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfEGU' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). The @Float@ parameter is a number between 0 and 1 showing the level of +-- reducing the noise (the greater number means that the function will reduce more intensively may be even aggressively so that for greater +-- numbers it can remove some sensitive and important sound data as a noise). Internally this parameter is passed unchanged to the \"sox\" +-- so that it uses it as an amount parameter for the \"noisered\" effect. Therefore, please, (as being stated in the SoX manual) experiment +-- with the amount to get suitable results. +noiseReduceEUG :: ULencode -> FilePath -> Float -> IO () +noiseReduceEUG ul file amount = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["noisered", file10 ++ ".e.prof", showFFloat (Just 4) amount $ show 0] + twoExceptions1File code file20 (NotCreatedWithEffect "noisered") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("_." ++ file) + +-- | Function 'volS' changes the given audio with the linear ratio for the amplitude so that the resulting amlitude is equal to the given @Float@ parameter. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). +volSG :: ULencode -> FilePath -> Float -> IO () +volSG ul file amplitude = if isJust (showE "sox") + then do + normG ul file + e0 <- doesFileExist $ "8" ++ file + if e0 + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["vol", showFFloat Nothing amplitude $ show 0, "amplitude"] + if code /= ExitSuccess + then secondFileClean file10 file20 (NotCreatedWithEffect "vol") + else presenseCheck file20 (InitialFileNotChanged file10) + else catchEnd (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul ("8" ++ file) ("8." ++ file) + +-- | Function 'volS2G' changes the given audio (the first 'FilePath' parameter, which must be normalized e. g. by the 'norm' function before) with +-- the linear ratio for the amplitude so that the resulting amlitude is equal to the maximum by absolute value amplitude for the file given +-- by the second 'FilePath' parameter. The function must be used with the first 'FilePath' parameter containing no directories in its name +-- (that means the file of the first 'FilePath' parameter must be in the same directory where the function is called from). +volS2G :: ULencode -> FilePath -> FilePath -> IO () +volS2G ul fileA fileB = if isJust (showE "sox") + then do + upp <- upperBndG ul fileB + amplMax <- selMAG ul fileB (0, upp) True + amplMin <- selMAG ul fileB (0, upp) False + let ampl = read (fst . maxAbs $ (amplMax, amplMin))::Float + (code, _, _) <- soxOpG ul [] file10 [] file20 ["vol", showFFloat Nothing ampl $ show 0, "amplitude"] + twoExceptions1File code file20 (NotCreatedWithEffect "vol") (InitialFileNotChanged fileA) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul fileA ("8." ++ tail fileA) + +-- | Function 'sincAG' uses a \"sinc\" effect with @-a 50 -I 0.07k-11k@ band-pass filter for the audio file given. +sincAG :: ULencode -> FilePath -> IO () +sincAG ul file = if isJust (showE "sox") + then do + (code, _, _) <- soxOpG ul [] file10 [] file20 ["sinc", "-a", "50", "-I", "0.07k-11k"] + twoExceptions1File code file20 (NotCreatedWithEffect "sinc") (InitialFileNotChanged file10) + else catchEnd ExecutableNotProperlyInstalled + where (file10, file20) = applyExts2 ul file ("4." ++ file) + +-- | Function 'sampleAnG' analyzes the one sample of the 1-channel sound file (or k samples for the k-channel file) and returns a tuple pair of +-- the maximum and minimum amplitudes of the sound given as 'String's. For the 1-channel sound file they are the same. +-- The 'Integer' parameter is the number of the sample, starting from which SoX analyzes the sound. If it is less than number of the samples available, +-- then the function returns the value for the last one sample for the 1-channel file (or the last k samples for the k-channel sound file). +-- The file must not be in a RAW format for the function to work properly. +sampleAnG :: ULencode -> FilePath -> Integer -> IO (String, String) +sampleAnG ul file pos = if isJust (showE "sox") && isJust (showE "soxi") + then onException (do + (_, hout, _) <- readProcessWithExitCode (fromJust (showE "soxi")) (if ul < UL0 then ["-s", file] else mconcat [["-s"],ulAccessParameters,[file]]) "" + let length0 = read hout::Integer + f param = do + (_, _, herr) <- soxOpG1 ul [] file [] ["trim", show param ++ "s", "1s", "stat"] + let lns = map (last . words) . drop 3 . take 5 . lines $ herr in return (head lns, last lns) + if compare length0 (fromIntegral pos) == GT + then f pos + else f (length0 - 1)) (catchEnd (NotEnoughData file)) + else catchEnd ExecutableNotProperlyInstalled >> return ("","") + +--------------------------------------------------------------- + +getMaxA = getMaxAG W + +getMinA = getMinAG W + +selMaxAbs = selMaxAbsG W + +selMA = selMAG W + +extremeS = extremeSG W + +extremeS1 = extremeSG1G W + +soxStat = soxStatG W + +upperBnd = upperBndG W + +durationA = durationAG W + +sampleAn = sampleAnG W + +alterVadB = alterVadBG W + +alterVadE = alterVadEG W + +alterVadHelp = alterVadHelpG W + +opFile = opFileG W + +norm = normG W + +normL = normLG W + +gainL = gainLG W + +quarterSinFade = quarterSinFadeG W + +silenceBoth = silenceBothG W + +resampleA = resampleAG W + +noiseProfB = noiseProfBG W + +noiseProfE = noiseProfEG W + +noiseReduceB = noiseReduceBG W + +noiseReduceE = noiseReduceEG W + +noiseReduceBU = noiseReduceBUG W + +noiseReduceEU = noiseReduceEUG W + +sincA = sincAG W + +volS = volSG W + +volS2 = volS2G W + diff --git a/Sound/SoXBasics1.hs b/Sound/SoXBasics1.hs new file mode 100644 index 0000000..f2d3a70 --- /dev/null +++ b/Sound/SoXBasics1.hs @@ -0,0 +1,291 @@ +-- | +-- Module : Sound.SoXBasics1 +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- A program and a library that can be used as a simple basic interface to some SoX functionality. +-- This module differs from the "Sound.SoXBasics" that the resulting files +-- in it have possibly just the same name as the input ones. The functions +-- try to replace the initial file with the processed one. There is no possibility using these +-- functions to change the file extension. If you use this module and "Sound.SoXBasics" functionalities together, +-- please, use qualified import to avoid misusage. + + +module Sound.SoXBasics1 ( + -- * Produce sound + -- ** Amplitude modification + norm + , normL + , gainL + , quarterSinFade + -- ** Adding silence + , silenceBoth + -- ** Changing sample rate + , resampleA + -- ** Working with noise + , noiseReduceB + , noiseReduceE + , noiseReduceBU + , noiseReduceEU + -- ** Filtering + , sincA + -- ** Volume amplification + , volS + , volS2 +) where + +import System.Directory +import Data.Maybe (isJust, fromJust) +import Numeric +import System.Process +import EndOfExe +import System.Exit +import qualified Sound.SoXBasics as SB (ULencode(..), SoundFileExts(..), soxOpG, soxOpG1, + ulAccessParameters, ulResultParameters, doubleCleanCheck, presenseCheck, secondFileClean, + twoIntermediateFs, twoExceptions1File, applyExts2, beforeExtStr, extremeS1,upperBndG,selMAG,maxAbs,normG) +import Sound.Control.Exception.FinalException + +moveSnd2Fst :: FilePath -> FilePath -> FinalException -> IO () +moveSnd2Fst file1 file2 exception = do + e2 <- doesFileExist file2 + if e2 + then do + removeFile file1 + renameFile file2 file1 + else catchEnd exception + +getULFromExt :: FilePath -> SB.ULencode +getULFromExt file = + case end of + ".wav" -> SB.W + (z:".ul") -> SB.UL + _ -> error "Sound.SoXBasics1.getULFromExt: The file has neither .wav, nor .ul extension." + where l = length file - 4 + (begin,end) = splitAt l file + +-- | Function 'norm' applies a SoX normalization effect on the audio file. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +norm :: FilePath -> IO () +norm file = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("8" ++ file) ["norm"] + if code /= ExitSuccess + then SB.doubleCleanCheck ("8" ++ file) (NotCreatedWithEffect "norm") + else moveSnd2Fst ("8" ++ file) file (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +twoExceptions2Files :: ExitCode -> FilePath -> FilePath -> FinalException -> FinalException -> IO () +twoExceptions2Files code file1 file2 exc1 exc2 = + if code /= ExitSuccess then SB.doubleCleanCheck file2 exc1 else moveSnd2Fst file1 file2 exc2 + +-- | Function 'normL' applies a SoX gain effect on the audio file with the maximum absolute dB value given by the 'Int' argument. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +normL :: FilePath -> Int -> IO () +normL file level = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("9" ++ file) ["gain", "-n", show level] + twoExceptions2Files code file ("9" ++ file) (NotCreatedWithEffect "gain -n") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'normL' applies a SoX \"gain -b [db-Value]\" effect on the audio file with dB value given by the @Float@ argument. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +gainL :: FilePath -> Float -> IO () +gainL file level = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("9" ++ file) ["gain", "-b", showFFloat (Just 6) level $ show 0] + twoExceptions2Files code file ("9" ++ file) (NotCreatedWithEffect "gain -b") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'quarterSinFade' applies a fade effect by SoX to the audio file with \"q\" type. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +quarterSinFade :: FilePath -> IO () +quarterSinFade file = if isJust (showE "sox") + then do + pos <- SB.extremeS1 file + upp <- SB.upperBndG (getULFromExt file) file + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("4" ++ file) ["fade", "q", show pos ++ "s", "=" ++ show upp ++ "s", show (upp - pos) ++ "s"] + twoExceptions2Files code file ("4" ++ file) (NotCreatedWithEffect "fade q") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +threeFiles1Exception :: ExitCode -> FilePath -> FilePath -> FilePath -> FinalException -> IO () +threeFiles1Exception code file1 file2 file3 exception + | code /= ExitSuccess = do + e2 <- doesFileExist file3 + if e2 then removeFile file3 else putStr "" + removeFile file2 + catchEnd exception + | otherwise = do + e3 <- doesFileExist file3 + removeFile file2 + if e3 + then do + removeFile file1 + renameFile file3 file1 + else catchEnd exception + +-- | Function 'silenceBoth' adds some silence to both ends of the audio. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +silenceBoth :: FilePath -> Int -> Int -> IO () +silenceBoth file beginning end = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("3" ++ file) ["delay", show beginning ++ "s", "reverse"] + if code /= ExitSuccess + then SB.doubleCleanCheck ("3" ++ file) (NotCreatedWithEffects "delay reverse") + else do + e2 <- doesFileExist $ "3" ++ file + if e2 + then do + (code1, _, _) <- SB.soxOpG (getULFromExt file) [] ("3" ++ file) [] ("2" ++ file) ["delay", show end ++ "s", "reverse"] + threeFiles1Exception code1 file ("3" ++ file) ("2" ++ file) (NotCreated file) + else catchEnd (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'resampleA' changes the sample rate for the recorded audio for further processing. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +resampleA :: FilePath -> Int -> IO () +resampleA file frequency = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("3" ++ file) ["rate", "-s", "-I", show frequency] + twoExceptions2Files code file ("3" ++ file) (NotCreatedWithEffect "rate") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'noiseReduceB' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfB' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +noiseReduceB :: FilePath -> IO () +noiseReduceB file = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("_" ++ file) ["noisered", file ++ ".b.prof"] + twoExceptions2Files code file ("_" ++ file) (NotCreatedWithEffect "noisered") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'noiseReduceE' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfE' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +noiseReduceE :: FilePath -> IO () +noiseReduceE file = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("_." ++ file) ["noisered", file ++ ".e.prof"] + twoExceptions2Files code file ("_." ++ file) (NotCreatedWithEffect "noisered") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'noiseReduceBU' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfBU' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). The @Float@ parameter is a number between 0 and 1 showing the level of +-- reducing the noise (the greater number means that the function will reduce more intensively may be even aggressively so that for greater +-- numbers it can remove some sensitive and important sound data as a noise). Internally this parameter is passed unchanged to the \"sox\" +-- so that it uses it as an amount parameter for the \"noisered\" effect. Therefore, please, (as being stated in the SoX manual) experiment +-- with the amount to get suitable results. While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +noiseReduceBU :: FilePath -> Float -> IO () +noiseReduceBU file amount = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("_" ++ file) ["noisered", file ++ ".b.prof", showFFloat (Just 4) amount $ show 0] + twoExceptions2Files code file ("_" ++ file) (NotCreatedWithEffect "noisered") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'noiseReduceEU' reduces with SoX a noise in the file given with the corresponding noise profile created with 'noiseProfE' function. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). The @Float@ parameter is a number between 0 and 1 showing the level of +-- reducing the noise (the greater number means that the function will reduce more intensively may be even aggressively so that for greater +-- numbers it can remove some sensitive and important sound data as a noise). Internally this parameter is passed unchanged to the \"sox\" +-- so that it uses it as an amount parameter for the \"noisered\" effect. Therefore, please, (as being stated in the SoX manual) experiment +-- with the amount to get suitable results. While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +noiseReduceEU :: FilePath -> Float -> IO () +noiseReduceEU file amount = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("_." ++ file) ["noisered", file ++ ".e.prof", showFFloat (Just 4) amount $ show 0] + twoExceptions2Files code file ("_." ++ file) (NotCreatedWithEffect "noisered") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'volS' changes the given audio with the linear ratio for the amplitude so that the resulting amlitude is equal to the given @Float@ parameter. +-- The function must be used with the 'FilePath' parameter containing no directories in its name (that means the file of the 'FilePath' parameter must be +-- in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +volS :: FilePath -> Float -> IO () +volS file amplitude = if isJust (showE "sox") + then do + SB.normG (getULFromExt file) file + e0 <- doesFileExist $ "8" ++ file + if e0 + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] ("8" ++ file) [] ("8." ++ file) ["vol", showFFloat Nothing amplitude $ show 0, "amplitude"] + if code /= ExitSuccess + then do + e1 <- doesFileExist $ "8." ++ file + if e1 + then do + removeFile $ "8." ++ file + removeFile $ "8" ++ file + catchEnd (NotCreatedWithEffect "vol") + else do + removeFile $ "8" ++ file + catchEnd (NotCreatedWithEffect "vol") + else do + e2 <- doesFileExist $ "8." ++ file + if e2 + then do + removeFile file + removeFile $ "8" ++ file + renameFile ("8." ++ file) file + else do + removeFile $ "8" ++ file + catchEnd (InitialFileNotChanged file) + else catchEnd (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'volS2' changes the given audio (the first 'FilePath' parameter, which must be normalized e. g. by the 'norm' function before) with +-- the linear ratio for the amplitude so that the resulting amlitude is equal to the maximum by absolute value amplitude for the file given +-- by the second 'FilePath' parameter. The function must be used with the first 'FilePath' parameter containing no directories in its name +-- (that means the file of the first 'FilePath' parameter must be in the same directory where the function is called from). While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +volS2 :: FilePath -> FilePath -> IO () +volS2 fileA fileB = if isJust (showE "sox") + then do + upp <- SB.upperBndG (getULFromExt fileB) fileB + amplMax <- SB.selMAG (getULFromExt fileB) fileB (0, upp) True + amplMin <- SB.selMAG (getULFromExt fileB) fileB (0, upp) False + let ampl = read (fst . SB.maxAbs $ (amplMax, amplMin))::Float + (code, _, _) <- SB.soxOpG (getULFromExt fileA) [] fileA [] ("8." ++ tail fileA) ["vol", showFFloat Nothing ampl $ show 0, "amplitude"] + twoExceptions2Files code fileA ("8." ++ tail fileA) (NotCreatedWithEffect "vol") (InitialFileNotChanged fileA) + else catchEnd ExecutableNotProperlyInstalled + +-- | Function 'sincA' uses a \"sinc\" effect with @-a 50 -I 0.07k-11k@ band-pass filter for the audio file given. While being +-- executed the function tries to replace the initial file with the resulting processed one and to clean the temporary files. If it is not +-- successful the function exits with exception of the type 'FinalException' and leaves the initial file without modification. +sincA :: FilePath -> IO () +sincA file = if isJust (showE "sox") + then do + (code, _, _) <- SB.soxOpG (getULFromExt file) [] file [] ("4." ++ file) ["sinc", "-a", "50", "-I", "0.07k-11k"] + twoExceptions2Files code file ("4." ++ file) (NotCreatedWithEffect "sinc") (InitialFileNotChanged file) + else catchEnd ExecutableNotProperlyInstalled + diff --git a/mmsyn7ukr-common.cabal b/mmsyn7ukr-common.cabal new file mode 100644 index 0000000..48e9fda --- /dev/null +++ b/mmsyn7ukr-common.cabal @@ -0,0 +1,25 @@ +-- Initial mmsyn7ukr-common.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: mmsyn7ukr-common +version: 0.1.0.0 +synopsis: Some common for mmsyn7ukr and mmsyn7ukr-array functionality using SoX. +description: A program and a library that can be used as a simple basic interface to some SoX functionality. +homepage: https://hackage.haskell.org/package/mmsyn7ukr-common +license: MIT +license-file: LICENSE +author: OleksandrZhabenko +maintainer: olexandr543@yahoo.com +copyright: (c) Oleksandr Zhabenko 2019-2021 +category: Language, Sound +build-type: Simple +extra-source-files: ChangeLog.md, README.markdown +cabal-version: >=1.10 + +library + exposed-modules: Sound.SoXBasics, Sound.SoXBasics1, Parser.ReplaceP, Sound.Control.Exception.FinalException + -- other-modules: + other-extensions: CPP, DeriveDataTypeable + build-depends: base >=4.7 && <4.15, process >=1.4 && <1.9, directory >=1.2.5 && <1.5, mmsyn3 >=0.1.5 && <1 + -- hs-source-dirs: + default-language: Haskell2010 |