diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -207,3 +207,9 @@ ## 0.22.1.0 -- 2020-04-02 * Twenty-second version revised A. Fixed issues with being not compiled because of the syntaxis issues. + +## 0.23.0.0 -- 2020-04-03 + +* Twenty-third version. Added 2G generalized functions to the DobutokO.Sound.Functional, and DobutokO.Sound.IntermediateF, and to DobutokO.Sound.Executable +modules. They allow to specify sound quality of the resulting files using additional parameter. Added also additional (including 1G) functions +to the same modules. Some code and documentation improvements. Added new command line options with "2" at the end. diff --git a/DobutokO/Sound/Executable.hs b/DobutokO/Sound/Executable.hs --- a/DobutokO/Sound/Executable.hs +++ b/DobutokO/Sound/Executable.hs @@ -38,9 +38,10 @@ import DobutokO.Sound hiding (dobutokO2, recAndProcess) import DobutokO.Sound.IntermediateF import DobutokO.Sound.ParseList (parseStoLInts) +import DobutokO.Sound.Functional (soxBasicParams) -- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing --- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten. +-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end*\" files in the current directory, because they can be overwritten. dobutokO2 :: IO () dobutokO2 = do arggs <- getArgs @@ -51,73 +52,67 @@ exist2 <- doesFileExist file getBFst' (dobutokO2H exist2 args file, V.fromList . fmap (\(xs, f) -> (xs,f exist2 args file)) $ [("0",o2help),("1",dobutokO2H1),("11",dobutokO2H11), ("2",dobutokO2H2),("21",dobutokO2H21),("3",dobutokO2H3),("31",dobutokO2H31),("4",dobutokO2H4),("41",dobutokO2H41),("5",dobutokO2H5), - ("51",dobutokO2H51),("61",dobutokO2H61),("7",dobutokO2H7),("8",dobutokO2H8),("80",dobutokO2H80),("9",dobutokO2H9),("99",dobutokO2H99 argss), - ("999",dobutokO2H999 argss)]) arg1 + ("51",dobutokO2H51),("61",dobutokO2H61),("7",dobutokO2H7),("8",dobutokO2H8),("80",dobutokO2H80),("82",dobutokO2H82),("820",dobutokO2H820), + ("9",dobutokO2H9),("92",dobutokO2H92),("99",dobutokO2H99 argss),("992",dobutokO2H992G argss),("999",dobutokO2H999 argss), + ("9992",dobutokO2H9992G argss)]) arg1 dobutokO2H1 :: Bool -> String -> FilePath -> IO () dobutokO2H1 exist2 args file = do [_,_,octave,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5] else [1..5]) - let octave1 = read octave::Int - ampL = read ampLS::Double - time3 = read time2::Double - overSoXSynthNGen file octave1 ampL time3 args + let (octave1,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in overSoXSynthNGen file octave1 ampL time3 args {-# INLINE dobutokO2H1 #-} +threeStr2Val :: [String] -> Maybe (Int,Double,Double) +threeStr2Val [xs,ys,zs] = Just (read xs::Int,read ys::Double,read zs::Double) +threeStr2Val _ = Nothing +{-# INLINE threeStr2Val #-} + +fourStr2Val :: [String] -> Maybe (Int,Double,Double,Double) +fourStr2Val [xs,ys,zs,tws] = Just (read xs::Int,read ys::Double,read zs::Double,read tws::Double) +fourStr2Val _ = Nothing +{-# INLINE fourStr2Val #-} + +fiveStr2Val :: [String] -> Maybe ([Int],Double,Double,Double) +fiveStr2Val [xs,ys,zs,tws] = Just (map (\z -> read z::Int) . words $ xs,read ys::Double,read zs::Double,read tws::Double) +fiveStr2Val _ = Nothing +{-# INLINE fiveStr2Val #-} + dobutokO2H2 :: Bool -> String -> FilePath -> IO () dobutokO2H2 exist2 args file = do [_,_,octave,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6] else [1..6]) - let octave1 = read octave::Int - ampL = read ampLS::Double - time3 = read time2::Double - uniqOverSoXSynthNGen file octave1 ampL time3 args wws + let (octave1,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in uniqOverSoXSynthNGen file octave1 ampL time3 args wws {-# INLINE dobutokO2H2 #-} dobutokO2H3 :: Bool -> String -> FilePath -> IO () dobutokO2H3 exist2 args file = do [_,_,octave,ampLS,time2,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7] else [1,2,3,4,5,7]) - let octave1 = read octave::Int - ampL = read ampLS::Double - time3 = read time2::Double - overSoXSynthNGen2 file octave1 ampL time3 args tts + let (octave1,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in overSoXSynthNGen2 file octave1 ampL time3 args tts {-# INLINE dobutokO2H3 #-} dobutokO2H4 :: Bool -> String -> FilePath -> IO () dobutokO2H4 exist2 args file = do [_,_,octave,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7] else [1..7]) - let octave1 = read octave::Int - ampL = read ampLS::Double - time3 = read time2::Double - uniqOverSoXSynthNGen3 file octave1 ampL time3 args wws tts + let (octave1,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in uniqOverSoXSynthNGen3 file octave1 ampL time3 args wws tts {-# INLINE dobutokO2H4 #-} dobutokO2H5 :: Bool -> String -> FilePath -> IO () dobutokO2H5 exist2 args file = do [_,_,octave,ampLS,time2,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7,8,9] else [1,2,3,4,5,7,8,9]) - let octave1 = read octave::Int - ampL = read ampLS::Double - time3 = read time2::Double - dAmpl = read dAmpl0::Double - overSoXSynthNGen3 file octave1 ampL time3 dAmpl args tts vs + let (octave1,ampL,time3,dAmpl) = fromJust . fourStr2Val $ [octave,ampLS,time2,dAmpl0] in overSoXSynthNGen3 file octave1 ampL time3 dAmpl args tts vs {-# INLINE dobutokO2H5 #-} dobutokO2H :: Bool -> String -> FilePath -> IO () dobutokO2H exist2 args file = do [_,_,octave,ampLS,time2,wws,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7,8,9] else [1..9]) - let octave1 = read octave::Int - ampL = read ampLS::Double - time3 = read time2::Double - dAmpl = read dAmpl0::Double - uniqOverSoXSynthNGen4 file octave1 ampL time3 dAmpl args wws tts vs + let (octave1,ampL,time3,dAmpl) = fromJust . fourStr2Val $ [octave,ampLS,time2,dAmpl0] in + uniqOverSoXSynthNGen4 file octave1 ampL time3 dAmpl args wws tts vs {-# INLINE dobutokO2H #-} dobutokO2H61 :: Bool -> String -> FilePath -> IO () dobutokO2H61 exist2 args file = do [_,_,complexNky,ampLS,time2,wws,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,6,7,8,9] else [1,2,11,4,5,6,7,8,9]) - let [enkA,nTh] = map (\z -> read z::Int) . words $ complexNky - ampL = read ampLS::Double - time3 = read time2::Double - dAmpl = read dAmpl0::Double - uniqOverSoXSynthNGen4E file nTh enkA ampL time3 dAmpl args wws tts vs + let ([enkA,nTh],ampL,time3,dAmpl) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,dAmpl0] in + uniqOverSoXSynthNGen4E file nTh enkA ampL time3 dAmpl args wws tts vs {-# INLINE dobutokO2H61 #-} dobutokO2H8 :: Bool -> String -> FilePath -> IO () @@ -152,50 +147,76 @@ return (code1, path8v) {-# INLINE dobutokO2H8G #-} +dobutokO2H82G :: Bool -> String -> FilePath -> IO (ExitCode, V.Vector FilePath) +dobutokO2H82G _ ys _ = do + path8s0 <- listDirectory "." + let path8v = V.fromList . L.sort . filter (isPrefixOf "result") $ path8s0 + path8v1 = V.generate (V.length path8v `quot` 800) (\i0 -> V.unsafeSlice (i0 * 800) 800 path8v ) `V.snoc` V.unsafeSlice (800 * + (V.length path8v `quot` 800)) (V.length path8v `rem` 800) path8v + if drop 3 ys == "f" then V.imapM_ dO2H8f path8v1 else V.imapM_ dO2H8 path8v1 + epath0s <- listDirectory "." + let epaths = L.sort . filter (isPrefixOf "end0") $ epath0s + (code1,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (epaths ++ soxBasicParams ys ("":["end.wav"])) "" + case code1 of + ExitSuccess -> mapM_ removeFile epaths + _ -> do + exiW <- doesFileExist "end.wav" + exiF <- doesFileExist "end.flac" + if exiW && not (exiF) + then do + removeFile "end.wav" + error "The end file \"end.wav\" was not created. " + else + if exiF && not (exiW) then do + removeFile "end.flac" + error "The end file \"end.flac\" was not created. " + else if exiF && exiW then do + removeFile "end.flac" + removeFile "end.wav" + error "The end file \"end.*\" was not created. " + else error "The end file \"end.*\" was not created. " + return (code1, path8v) +{-# INLINE dobutokO2H82G #-} + +dobutokO2H82 :: Bool -> String -> FilePath -> IO () +dobutokO2H82 exist2 ys file = void (dobutokO2H82G exist2 ys file) +{-# INLINE dobutokO2H82 #-} + +dobutokO2H820 :: Bool -> String -> FilePath -> IO () +dobutokO2H820 exist2 ys file = dobutokO2H82G exist2 ys file >>= \case + (ExitSuccess, path8v) -> mapM_ removeFile path8v + _ -> return () +{-# INLINE dobutokO2H820 #-} + dobutokO2H11 :: Bool -> String -> FilePath -> IO () dobutokO2H11 exist2 args file = do [_,_,complexNky,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5] else [1,2,11,4,5]) - let [enkA,nTh] = map (\z -> read z::Int) . words $ complexNky - ampL = read ampLS::Double - time3 = read time2::Double - overSoXSynthNGenE file nTh enkA ampL time3 args + let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in overSoXSynthNGenE file nTh enkA ampL time3 args {-# INLINE dobutokO2H11 #-} dobutokO2H21 :: Bool -> String -> FilePath -> IO () dobutokO2H21 exist2 args file = do [_,_,complexNky,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,6] else [1,2,11,4,5,6]) - let [enkA,nTh] = map (\z -> read z::Int) . words $ complexNky - ampL = read ampLS::Double - time3 = read time2::Double - uniqOverSoXSynthNGenE file nTh enkA ampL time3 args wws + let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in uniqOverSoXSynthNGenE file nTh enkA ampL time3 args wws {-# INLINE dobutokO2H21 #-} dobutokO2H31 :: Bool -> String -> FilePath -> IO () dobutokO2H31 exist2 args file = do [_,_,complexNky,ampLS,time2,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,7] else [1,2,11,4,5,7]) - let [enkA,nTh] = map (\z -> read z::Int) . words $ complexNky - ampL = read ampLS::Double - time3 = read time2::Double - overSoXSynthNGen2E file nTh enkA ampL time3 args tts + let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in overSoXSynthNGen2E file nTh enkA ampL time3 args tts {-# INLINE dobutokO2H31 #-} dobutokO2H41 :: Bool -> String -> FilePath -> IO () dobutokO2H41 exist2 args file = do [_,_,complexNky,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,6,7] else [1,2,11,4,5,6,7]) - let [enkA,nTh] = map (\z -> read z::Int) . words $ complexNky - ampL = read ampLS::Double - time3 = read time2::Double - uniqOverSoXSynthNGen3E file nTh enkA ampL time3 args wws tts + let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in uniqOverSoXSynthNGen3E file nTh enkA ampL time3 args wws tts {-# INLINE dobutokO2H41 #-} dobutokO2H51 :: Bool -> String -> FilePath -> IO () dobutokO2H51 exist2 args file = do [_,_,complexNky,ampLS,time2,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,7,8,9] else [1,2,11,4,5,7,8,9]) - let [enkA,nTh] = map (\z -> read z::Int) . words $ complexNky - ampL = read ampLS::Double - time3 = read time2::Double - dAmpl = read dAmpl0::Double - overSoXSynthNGen3E file nTh enkA ampL time3 dAmpl args tts vs + let ([enkA,nTh],ampL,time3,dAmpl) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,dAmpl0] in + overSoXSynthNGen3E file nTh enkA ampL time3 dAmpl args tts vs {-# INLINE dobutokO2H51 #-} dO2H8 :: Int -> V.Vector String -> IO () @@ -212,14 +233,39 @@ else error $ "The intermediate file " ++ "\"end0" ++ show i ++ ".wav\" was not created. " {-# INLINE dO2H8 #-} +dO2H8f :: Int -> V.Vector String -> IO () +dO2H8f i v = do + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (V.toList v ++ ["end0" ++ show i ++ ".flac"]) "" + case code of + ExitSuccess -> putStr "" + _ -> do + exi0 <- doesFileExist $ "end0" ++ show i ++ ".flac" + if exi0 + then do + removeFile $ "end0" ++ show i ++ ".flac" + error $ "The intermediate file " ++ "\"end0" ++ show i ++ ".flac\" was not created. " + else error $ "The intermediate file " ++ "\"end0" ++ show i ++ ".flac\" was not created. " +{-# INLINE dO2H8f #-} + -- | Actually works as 'pAnR_' function. dobutokO2H9 :: Bool -> String -> FilePath -> IO () dobutokO2H9 _ _ _ = pAnR_ {-# INLINE dobutokO2H9 #-} +-- | Actually works as 'pAnR_2G' function. +dobutokO2H92 :: Bool -> String -> FilePath -> IO () +dobutokO2H92 _ ys _ = pAnR_2G ys +{-# INLINE dobutokO2H92 #-} + dobutokO2H99 :: [String] -> Bool -> String -> FilePath -> IO () dobutokO2H99 argss _ _ file = do - dir0V <- listVDirectory + (v1,dir0V) <- dO2H99 "221w" file + V.mapM_ (\idx -> playE (V.unsafeIndex dir0V idx) argss) v1 +{-# INLINE dobutokO2H99 #-} + +dO2H99 :: String -> FilePath -> IO (V.Vector Int,V.Vector FilePath) +dO2H99 ys file = do + dir0V <- listVDirectory2G ys let l0 = V.length dir0V putStrLn $ "You have available " ++ show l0 ++ " files that can be played. The minimum index further is 0, the maximum is " ++ show (l0 - 1) list1 <- recAndProcess file (99::Int) @@ -229,24 +275,27 @@ mnE = fromMaybe 0 (minLinV v01) zss = map (filterToBnds mnE mxE) yss v1 = doubleLtoV zss + return (v1,dir0V) +{-# INLINE dO2H99 #-} + +dobutokO2H992G :: [String] -> Bool -> String -> FilePath -> IO () +dobutokO2H992G argss _ ys file = do + (v1,dir0V) <- dO2H99 ys file V.mapM_ (\idx -> playE (V.unsafeIndex dir0V idx) argss) v1 -{-# INLINE dobutokO2H99 #-} +{-# INLINE dobutokO2H992G #-} dobutokO2H999 :: [String] -> Bool -> String -> FilePath -> IO () dobutokO2H999 argss _ _ file = do - dir0V <- listVDirectory - let l0 = V.length dir0V - putStrLn $ "You have available " ++ show l0 ++ " files that can be processed. The minimum index further is 0, the maximum is " ++ show (l0 - 1) - list1 <- recAndProcess file (999::Int) - let yss = divideToStr l0 list1 - v01 = V.fromList yss - mxE = fromMaybe (l0 - 1) (maxLinV v01) - mnE = fromMaybe 0 (minLinV v01) - zss = map (filterToBnds mnE mxE) yss - v1 = doubleLtoV zss + (v1,dir0V) <- dO2H99 "221w" file V.mapM_ (\idx -> soxE1 (V.unsafeIndex dir0V idx) argss) v1 {-# INLINE dobutokO2H999 #-} +dobutokO2H9992G :: [String] -> Bool -> String -> FilePath -> IO () +dobutokO2H9992G argss _ ys file = do + (v1,dir0V) <- dO2H99 ys file + V.mapM_ (\idx -> soxE1 (V.unsafeIndex dir0V idx) argss) v1 +{-# INLINE dobutokO2H9992G #-} + divideToStr :: Int -> String -> [[Int]] divideToStr n = map (parseStoLInts n). lines @@ -340,7 +389,7 @@ recAndProcess :: FilePath -> Int -> IO String recAndProcess file = getBFst' (processD, V.fromList [(0,processD0 file),(1,processD1),(2,processD2 file),(3,processD3),(4,processD4),(5,processD5),(7,processD7), - (8,processD8),(9,processD9),(11,processD_1),(99,processD99),(999,processD999)]) + (8,processD8),(9,processD9),(11,processD_1),(99,processD99),(999,processD99)]) processD_1 :: IO String processD_1 = onException (do @@ -557,7 +606,7 @@ processD99 :: IO String processD99 = onException (do - putStr "Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indeces for the files to be played " + putStr "Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indices for the files to be played " putStr "with SoX effects applied to. The lists must be separated with newline (just press \"Enter\"), empty lists are ignored. If index is " putStrLn "element of several input lists then if its number of occurrences in all the lists is odd, then it is played, otherwise it is not. " putStrLn "To end the input, just press the combination that means end of input (e. g. for Unices, it's probably Ctrl + D). " @@ -567,14 +616,3 @@ processD) {-# INLINE processD99 #-} -processD999 :: IO String -processD999 = onException (do - putStr "Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indeces for the files to be processed " - putStr "with SoX effects applied to. The lists must be separated with newline (just press \"Enter\"), empty lists are ignored. If index is " - putStrLn "element of several input lists then if its number of occurrences in all the lists is odd, then it is played, otherwise it is not. " - putStrLn "To end the input, just press the combination that means end of input (e. g. for Unices, it's probably Ctrl + D). " - getContents) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD) -{-# INLINE processD999 #-} diff --git a/DobutokO/Sound/Functional.hs b/DobutokO/Sound/Functional.hs --- a/DobutokO/Sound/Functional.hs +++ b/DobutokO/Sound/Functional.hs @@ -57,7 +57,23 @@ , overSoXSynth2FDN1G , overSoXSynth2FDN_B1G , overSoXSynth2FDN_S1G + , overSoXSynth2FDN_Sf1G + , overSoXSynth2FDN_Sf31G , partialTest_k1G + -- * 2G generalized functions with additional sound quality specifying + , overSoXSynth2FDN2G + , overSoXSynth2FDN_B2G + , overSoXSynth2FDN_S2G + , overSoXSynth2FDN_Sf2G + , overSoXSynth2FDN_Sf32G + , partialTest_k2G + , soundGenF32G + -- ** 2G generalized functions for melody producing + , overSoXSynthGen2FDN_SG2G + , overSoXSynthGen2FDN_Sf3G2G + -- ** 2G generalized auxiliary functions + , mixTest2G + , endFromResult2G -- * Generalized functions with several functional parameters , soundGenF3 , overSoXSynthGen2FDN_SG @@ -65,6 +81,7 @@ -- ** 1G generalized function with db volume overtones adjustments and several functional parameters , soundGenF31G -- ** Auxiliary functions + , soxBasicParams , adjust_dbVol , partialTest_k , prependZeroes @@ -122,6 +139,19 @@ | y == 0.0 = xss | otherwise = xss ++ ["vol",showFFloat (Just 4) y (show 0) ++ "dB","0.01"] +-- | Is used internally in the functions to specify different SoX parameters for the sound synthesis (rate, bit depth and file extension). Possible +-- file extensions are: ".wav" (a default one) and ".flac" (being lossless compressed); rates -- 8000, 11025, 16000, 22050 (a default one), 32000, +-- 44100, 48000, 88200, 96000, 176400, 192000 Hz; bit depths -- 16 bits and 24 bits. The first two digits in a 'String' argument encodes rate, +-- the next one -- bit depth and the last symbol -- letter \'w\' or \'f\' -- file extension. Because of SoX uses FLAC optionally, before use it, please, +-- check whether your installation supports it. +soxBasicParams :: String -> [String] -> [String] +soxBasicParams ys xss + | null xss = [] + | otherwise = + let (ts,zs) = splitAt 2 . init $ ys in (getBFst' ("-r22050",V.fromList . zip ["11","16", "17", "19", "32", "44", "48", "80", "96"] $ + ["-r11025","-r16000","-r176400","-r192000","-r32000","-r44100","-r48000","-r8000","-r96000"]) ts) : (if zs == "2" then "-b24" else "-b16") : + ((if drop 3 ys == "f" then map (\xs -> if drop (length xs - 4) xs == ".wav" then take (length xs - 4) xs ++ ".flac" else xs) else id) . tail $ xss) + -- | 'V.Vector' of 'Double' is a vector of dB volume adjustments for the corresponding harmonices (overtones). overSoXSynth2FDN1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () overSoXSynth2FDN1G f (x, y) j zs vdB @@ -156,6 +186,41 @@ overSoXSynthHelp2 v1 vdB mixTest +-- | Similar to 'overSoXSynth2FDN1G', but additionally allows to specify by the second 'String' argument a quality changes to the generated files +-- (please, see 'soxBasicParams'). +overSoXSynth2FDN2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN2G f (x, y) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = length zs + note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k + v0 = g note0 + v1 = maybe V.empty g note1 + ts = showFFloat (Just 4) (abs y) $ show 0 + overSoXSynthHelp vec = + let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + (soxBasicParams ys ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0, + "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0]) "") vec + overSoXSynthHelp2 vec vdB = + let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0, + "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] (V.unsafeIndex vdB i))) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ + show 0,"sine", showFFloat (Just 4) note0 $ show 0]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ + show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + mixTest2G ys + -- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set -- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12. -- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. A 'Double' parameter is a @@ -184,6 +249,15 @@ _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" mapM_ removeFile paths +-- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to +-- 'soxBasicParams'. +mixTest2G :: String -> IO () +mixTest2G ys = do + paths0 <- listDirectory "." + let paths = sort . filter (isPrefixOf "test") $ paths0 + _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["result.wav","vol","0.3"]) "" + mapM_ removeFile paths + -- | Gets an \"end.wav\" file from the intermediate \"result\*.wav\" files in the current directory. If it is not successful, produces the notification -- message and exits without error. If you would like to create the file if there are too many intermediate ones, please, run -- \"dobutokO2 8\" or \"dobutokO2 80\" in the current directory. @@ -198,8 +272,23 @@ exi <- doesFileExist "end.wav" if exi then removeFile "end.wav" else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >> - putStrLn "Use them manually as needed." + putStrLn "Use them manually as needed." +-- | Similar to 'endFromResult', but uses additional 'String' argument to change sound quality parameters. For more information, please, refer to +-- 'soxBasicParams'. +endFromResult2G :: String -> IO () +endFromResult2G ys = do + path2s <- listDirectory "." + let paths3 = sort . filter (isPrefixOf "result") $ path2s + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ soxBasicParams ys ["","end.wav"]) "" + case code of + ExitSuccess -> putStrLn $ "The final file \"end." ++ if drop 3 ys == "f" then "flac" else "wav" ++ "\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " + _ -> do + exi <- doesFileExist $ "end." ++ if drop 3 ys == "f" then "flac" else "wav" + if exi then removeFile $ "end." ++ if drop 3 ys == "f" then "flac" else "wav" + else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >> + putStrLn "Use them manually as needed." + -- | Creates part of the needed \"test\*\.wav" files in the current directory. partialTest_k :: OvertonesO -> Int -> String -> IO () partialTest_k vec k ts = @@ -242,6 +331,30 @@ else readProcessWithExitCode (fromJust (showE "sox")) (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] (V.unsafeIndex vdB i)) "" >> putStr "") vec +-- | Generalized version of the 'partialTest_k1G' with a possibility to change sound quality parameters using the additional second 'String' argument. +-- For more information, please, refer to 'soxBasicParams'. +partialTest_k2G :: OvertonesO -> Int -> String -> V.Vector Double -> String -> IO () +partialTest_k2G vec k ts vdB ys = + let l = V.length vec + zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 50 == 0 + then do + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", + "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] + (V.unsafeIndex vdB i))) "" + path1s <- listDirectory "." + let path2s = sort . filter (isPrefixOf $ "test" ++ show k) $ path1s + (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ soxBasicParams ys ["","test-" ++ show k ++ + prependZeroes zeroN (show (i `quot` 50)) ++ ".wav"]) "" + case code of + ExitSuccess -> mapM_ removeFile path2s + _ -> do + exi <- doesFileExist $ "test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav" + if exi then putStrLn ("DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav") + else putStrLn $ "DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0 + else readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", + "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] + (V.unsafeIndex vdB i))) "" >> putStr "") vec + -- | Generates a 'V.Vector' of 'OvertonesO' that represents the sound. doubleVecFromVecOfDouble :: (Double -> OvertonesO) -> Double -> V.Vector (Maybe Double) -> V.Vector OvertonesO doubleVecFromVecOfDouble f t0 = @@ -299,6 +412,44 @@ overSoXSynthHelp2 v1 vdB mixTest +-- | Generalized version of the 'overSoXSynth2FDN_B1G' with a possibility to specify sound quality parameters using additional second 'String' +-- argument. For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_B2G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_B2G f (x, y, limB) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10 + limA = if compare limA0 0.1 == LT then 0.1 else limA0 + l0 = length zs + note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + v0 = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 note0) $ 0), z0)) . g0 $ note0 + v1 = if isNothing note1 then V.empty + else V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 . fromJust $ note1) $ 0), z0)) . g0 . fromJust $ note1 + ts = showFFloat (Just 4) (abs y) $ show 0 + overSoXSynthHelp vec = + let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + (soxBasicParams ys ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0, + "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0]) "") vec + overSoXSynthHelp2 vec vdB = + let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0, + "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] (V.unsafeIndex vdB i))) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ + show 0,"sine", showFFloat (Just 4) note0 $ show 0]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ + show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + mixTest2G ys + -- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set -- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12. -- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. The first 'Double' parameter is a @@ -355,8 +506,30 @@ showFFloat (Just 4) (fromJust note1) $ show 0] "" partialTest_k1G v0 0 ts vdB partialTest_k1G v1 1 ts vdB - mixTest + mixTest +-- | Generalized version of the 'overSoXSynth2FDN_S1G' with a possibility to specify sound quality parameters using the second 'String' argument. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_S2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_S2G f (x, y) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = length zs + note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 + v0 = f note0 + v1 = maybe V.empty f note1 + ts = showFFloat (Just 4) (abs y) $ show 0 + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ + show 0,"sine", showFFloat (Just 4) note0 $ show 0]) "" + if isNothing note1 then partialTest_k2G v0 0 ts vdB ys + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ + show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0]) "" + partialTest_k2G v0 0 ts vdB ys + partialTest_k2G v1 1 ts vdB ys + mixTest2G ys + -- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. overSoXSynthGen2FDN_SG :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () overSoXSynthGen2FDN_SG file m ku f y zs wws h = do @@ -372,6 +545,25 @@ renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB endFromResult +-- | Generalized variant of the 'overSoXSynthGen2FDN_SG' with a possibility to specify with the third 'String' argument sound quality parameters. +-- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynthGen2FDN_SG2G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) -> + (Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () +overSoXSynthGen2FDN_SG2G file m ku f y zs wws h ys = do + duration0 <- durationA file + let n = truncate (duration0 / 0.001) + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + (t, ws) = splitAt 1 . syllableStr n $ zs + m0 = length ws + zeroN = numVZeroesPre vecB + v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws ys + renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ + if drop 3 ys == "f" then ".flac" else ".wav") vecB + endFromResult2G ys + -- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. overSoXSynthGen2FDN_S :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () overSoXSynthGen2FDN_S file m ku f y zs wws = overSoXSynthGen2FDN_SG file m ku f y zs wws overSoXSynth2FDN_S @@ -387,6 +579,16 @@ overSoXSynth2FDN_Sf :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO () overSoXSynth2FDN_Sf f (x, y) = overSoXSynth2FDN_Sf3 f (x, y, 0.001) +-- | Generalized variant of the 'overSoXSynth2FDN_Sf' with a possibility to adjust volume using 'adjust_dbVol'. 'V.Vector' of 'Double' is +-- used to specify adjustments in dB. For more information, please, refer to 'adjust_dbVol'. +overSoXSynth2FDN_Sf1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () +overSoXSynth2FDN_Sf1G f (x, y) = overSoXSynth2FDN_Sf31G f (x, y, 0.001) + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf1G' with a possibility to specify sound quality using the second 'String' argument. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_Sf2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_Sf2G f (x, y) = overSoXSynth2FDN_Sf32G f (x, y, 0.001) + -- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf' function. overSoXSynthGen2FDN_Sf :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () overSoXSynthGen2FDN_Sf file m ku f y zs wws = do @@ -420,6 +622,30 @@ (V.replicate 2 x) (V.fromList [1,V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))]) f (x, y, t0) j zs mixTest +-- | Generalized variant of the 'overSoXSynth2FDN_Sf3' function with a possibility to adjust volume using 'adjust_dBVol'. 'V.Vector' of 'Double' +-- specifies the needed adjustments in dB. +overSoXSynth2FDN_Sf31G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> IO () +overSoXSynth2FDN_Sf31G f (x, y, t0) j zs vdB + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let l0 = length zs + soundGenF31G (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0) + (dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))]) + (V.replicate 2 x) (V.fromList [1,V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))]) f (x, y, t0) j zs vdB + mixTest + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_Sf32G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_Sf32G f (x, y, t0) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let l0 = length zs + soundGenF32G (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0) + (dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))]) + (V.replicate 2 x) (V.fromList [1,V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))]) f (x, y, t0) j zs vdB ys + mixTest2G ys + helpF1 :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> V.Vector (Maybe Double) helpF1 vf vd = V.map (\(f1,x,i2) -> @@ -462,7 +688,23 @@ V.imapM_ (\i note1 -> do _ <- readProcessWithExitCode (fromJust (showE "sox")) (adjust_dbVol ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth", showFFloat (Just 4) (abs y) $ show 0, "sine", showFFloat (Just 4) (V.unsafeIndex vDz i) $ show 0] (V.unsafeIndex vdB i)) "" - partialTest_k1G (V.unsafeIndex vNotes i) i ts vdB) vDz + partialTest_k1G (V.unsafeIndex vNotes i) i ts vdB) vDz + +-- | Generalized variant of the 'soundGenF31G' with a possibility to specify sound quality using the second 'String' argument. For more information, +-- please, refer to 'soxBasicParams'. +soundGenF32G :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> + String -> V.Vector Double -> String -> IO () +soundGenF32G vf vd vi f (x, y, t0) j zs vdB ys = do + let vD = helpF1 vf vd vi -- Vector of notes played simultaneously (e. g. just one, interval, accord etc.) + vDz = V.mapMaybe id vD -- The previous one without Nothings and Justs + ilDz = V.length vDz - 1 + vNotes = doubleVecFromVecOfDouble f t0 (V.map Just vDz) -- Vector of vectors of pairs (freq,ampl) -- notes and their absence (V.empty) with overtones + l0 = length zs + ts = showFFloat (Just 4) (abs y) $ show 0 -- duration of the sound to be generated + V.imapM_ (\i note1 -> do + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth", + showFFloat (Just 4) (abs y) $ show 0, "sine", showFFloat (Just 4) (V.unsafeIndex vDz i) $ show 0] (V.unsafeIndex vdB i))) "" + partialTest_k2G (V.unsafeIndex vNotes i) i ts vdB ys) vDz -- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf3' function. overSoXSynthGen2FDN_Sf3 :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> IO () @@ -483,6 +725,25 @@ h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB endFromResult + +-- | Generalized variant of the 'ovorSoXSynthGen2FDN_Sf3G' with a possibility to specify sound quality with the third 'String' argument. +-- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynthGen2FDN_Sf3G2G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () +overSoXSynthGen2FDN_Sf3G2G file m ku f y t0 zs wws h ys = do + duration0 <- durationA file + let n = truncate (duration0 / 0.001) + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + (t, ws) = splitAt 1 . syllableStr n $ zs + m0 = length ws + zeroN = numVZeroesPre vecB + v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws ys + renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f" + then ".flac" else ".wav") vecB + endFromResult2G ys -- | Function to get from the number of semi-tones and a note a 'Maybe' note for the second lower note in the interval if any. If there is -- no need to obtain such a note, then the result is 'Nothing'. diff --git a/DobutokO/Sound/IntermediateF.hs b/DobutokO/Sound/IntermediateF.hs --- a/DobutokO/Sound/IntermediateF.hs +++ b/DobutokO/Sound/IntermediateF.hs @@ -6,7 +6,8 @@ -- Maintainer : olexandr543@yahoo.com -- -- A program and a library to create experimental music --- from a mono audio and a Ukrainian text. +-- from a mono audio and a Ukrainian text. Can work with both WAV and FLAC files if +-- your SoX installation supports FLAC. {-# OPTIONS_GHC -threaded #-} @@ -20,18 +21,24 @@ , isHighQ , shouldBeReplaced , indexesFromMrk - -- * Functions to edit the melody by editing the intermediate files \"result\*wav\" + -- * Functions to edit the melody by editing the intermediate files \"result\*\" , playAndMark , playAMrk , pAnR1 , pAnR2 , pAnR_ + -- ** 2G generalized variants + , playAMrk2G + , pAnR12G + , pAnR22G + , pAnR_2G -- * Additional functions -- ** Get information , infoFromV , internalConv , ixFromRes , ixInterv + , ixInterv2G , thisOne -- ** Process and Edit , playSeqAR @@ -45,21 +52,51 @@ , minLinV , doubleLtoV , filterToBnds - -- ** SoX effects application - -- *** With \"reverb\" as the first + -- * 2G generalized functions + , getFileRSizes2G + , getFileRSizesS2G + , getFileRTuples2G + , listVDirectory2G + -- ** Process and Edit + , playSeqAR2G + , playSeqARV2G + , playSeqARV22G + , playCollectDec2G + , replaceWithHQs2G + -- * SoX effects application + -- ** With \"reverb\" as the first + -- *** No file type changes , reverbE , reverbWE , reverb1E , reverbW1E - -- *** Generalized + -- *** File type changes + , reverbE2C + , reverbWE2C + , reverb1E2C + , reverb1WE2C + -- ** Generalized + -- *** No file type changes , soxE , soxE1 - -- *** Playing and recording + -- *** File type changes + , soxE2C + , soxE12C + -- ** Playing and recording , recE , rec1E , playE + -- * 2G auxiliary functions + , f2w + , w2f + , cfw2wf + , efw2 + , efw2vv + , wOrf + , wavToFlac ) where +import CaseBi (getBFst') import Control.Monad (void) import Control.Concurrent (myThreadId,forkIO,threadDelay,killThread) import qualified Data.List as L (sort) @@ -76,19 +113,30 @@ import System.Exit (ExitCode (ExitSuccess)) import System.Info (os) import DobutokO.Sound.ParseList (parseStoLInts) +import DobutokO.Sound.Functional (soxBasicParams) -- | Gets sizes of the \"result\*.wav\" files in the current directory. getFileRSizes :: IO (V.Vector Integer) -getFileRSizes = do +getFileRSizes = getFileRSizes2G "221w" + +-- | Generalized variant of the 'getFileRSizes' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to +-- 'soxBasicParams'. +getFileRSizes2G :: String -> IO (V.Vector Integer) +getFileRSizes2G ys = do dirN <- listDirectory "." - let dirN1 = V.fromList . L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN - V.mapM getFileSize dirN1 + let dirN1 = V.fromList . L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dirN + V.mapM getFileSize dirN1 -- | Similar to 'getFileRSizes', but sizes are 'Int', not 'Integer'. For most cases it is more memory efficient. getFileRSizesS :: IO (V.Vector Int) -getFileRSizesS = do +getFileRSizesS = getFileRSizesS2G "221w" + +-- | Generalized variant of the 'getFileRSizesS' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to +-- 'soxBasicParams'. +getFileRSizesS2G :: String -> IO (V.Vector Int) +getFileRSizesS2G ys = do dirN0 <- listDirectory "." - let dirN2 = V.fromList . L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN0 + let dirN2 = V.fromList . L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dirN0 sizes1 <- V.mapM getFileSize dirN2 return . V.map fromIntegral $ sizes1 @@ -98,19 +146,29 @@ -- | Gets 'V.Vector' of tuples of the pairs of \"result\*.wav\" files and their respective sizes. getFileRTuples :: IO (V.Vector (FilePath,Integer)) -getFileRTuples = do +getFileRTuples = getFileRTuples2G "221w" + +-- | Generalized variant of the 'getFileRTuples' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to +-- 'soxBasicParams'. +getFileRTuples2G :: String -> IO (V.Vector (FilePath,Integer)) +getFileRTuples2G ys = do dirN <- listDirectory "." - let dirN0 = L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN + let dirN0 = L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dirN sizes0 <- mapM getFileSize dirN0 let tpls = V.fromList . zip dirN0 $ sizes0 - return tpls + return tpls -- | Gets 'V.Vector' of the filenames for \"result\*.wav\" files in the current directory. listVDirectory :: IO (V.Vector FilePath) -listVDirectory = do +listVDirectory = listVDirectory2G "221w" + +-- | Generalized variant of the 'listVDirectory' with a possibility to get 'FilePath' for either FLAC or WAV files. For more information, please, refer to +-- 'soxBasicParams'. +listVDirectory2G :: String -> IO (V.Vector FilePath) +listVDirectory2G ys = do dir0N <- listDirectory "." - let diNN = V.fromList . L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf ".wav" s) $ dir0N - return diNN + let diNN = V.fromList . L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dir0N + return diNN -- | During function evaluation you can listen to the sound files and mark them with \"1\" and \"0\". The first one means that the sound is considered -- of higher quality and is intended to be used as a replacement for the worse sounds markd by \"0\". The function returns a 'V.Vector' of specially formatted @@ -138,8 +196,13 @@ -- | Function 'playAndMark' applied to all the \"result\*.wav\" files in the current directory. playAMrk :: IO (V.Vector String) -playAMrk = listVDirectory >>= playAndMark +playAMrk = playAMrk2G "221w" +-- | Generalized variant of the 'playAMrk' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to +-- 'soxBasicParams'. +playAMrk2G :: String -> IO (V.Vector String) +playAMrk2G ys = listVDirectory2G ys >>= playAndMark + -- | Function-predicate to check whether a file corresponding to its 'String' argument is needed to be replaced while processing. shouldBeReplaced :: String -> Bool shouldBeReplaced (x:y:xs) @@ -167,73 +230,103 @@ -- | Given an index of the element in the 'listVDirectory' output returns a tuple of the boundaries of the indexes usable for playback. -- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1. ixInterv :: Int -> IO (Int, Int) -ixInterv index0 +ixInterv = ixInterv2G "221w" + +-- | Given an index of the element in the 'listVDirectory2G' (with the same 'String' as the second argument) output returns a tuple of the +-- boundaries of the indexes usable for playback. +-- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1. +ixInterv2G :: String -> Int -> IO (Int, Int) +ixInterv2G ys index0 | compare index0 0 == LT = do - dirV <- listVDirectory + dirV <- listVDirectory2G ys let l1 = V.length dirV case compare l1 13 of LT -> return (0,l1 - 1) _ -> return (0,11) | compare index0 7 == LT = do - dirV <- listVDirectory + dirV <- listVDirectory2G ys let l1 = V.length dirV case compare index0 (l1 - 5) of GT -> return (0, l1 - 1) _ -> return (0, index0 + 4) | otherwise = do - dirV <- listVDirectory + dirV <- listVDirectory2G ys let l1 = V.length dirV case compare l1 13 of LT -> return (0,l1 - 1) _ -> case compare index0 (l1 - 5) of GT -> return (index0 - 7, l1 - 1) - _ -> return (index0 - 7, index0 + 4) + _ -> return (index0 - 7, index0 + 4) --- | Parser to the result of 'listVDirectory' function to get the needed information. +-- | Parser to the result of 'listVDirectory2G' function to get the needed information. infoFromV :: V.Vector String -> [(V.Vector Int, V.Vector String)] infoFromV vec = map (internalConv . unzip . V.toList . V.map (break (== '*'))) [v1, v2] where (v1, v2) = V.partition shouldBeReplaced vec -- | Plays a sequence of sounds in the interval of them obtained by 'ixInterv' function. playSeqAR :: Int -> IO () -playSeqAR index0 = do - (minBnd,maxBnd) <- ixInterv index0 - dirV2 <- listVDirectory - mapM_ (playA . V.unsafeIndex dirV2) [minBnd..maxBnd] +playSeqAR = playSeqAR2G "221w" +-- | Generalized variant of the 'playSeqAR' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to +-- 'soxBasicParams'. +playSeqAR2G :: String -> Int -> IO () +playSeqAR2G ys index0 = do + (minBnd,maxBnd) <- ixInterv2G ys index0 + dirV2 <- listVDirectory2G ys + mapM_ (playA . V.unsafeIndex dirV2) [minBnd..maxBnd] + -- | Plays a sequence of consequential sounds in the melody in the interval of them obtained by 'ixInterv' function for each element index -- from 'V.Vector' of indexes. playSeqARV :: V.Vector Int -> IO () -playSeqARV vec = do - dirV2 <- listVDirectory +playSeqARV = playSeqARV2G "221w" + +-- | Generalized variant of the 'playSeqARV' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to +-- 'soxBasicParams'. +playSeqARV2G :: String -> V.Vector Int -> IO () +playSeqARV2G ys vec = do + dirV2 <- listVDirectory2G ys V.mapM_ (playA . V.unsafeIndex dirV2) vec --- | Plays a sequence of sounds considered of higher quality. +-- | Plays a sequence of WAV sounds considered of higher quality. playSeqARV2 :: V.Vector String -> IO () -playSeqARV2 vec = do +playSeqARV2 = playSeqARV22G "221w" + +-- | Plays a sequence of sounds considered of higher quality. +playSeqARV22G :: String -> V.Vector String -> IO () +playSeqARV22G ys vec = do let indexesHQs = fst . last . infoFromV $ vec - playSeqARV indexesHQs + playSeqARV2G ys indexesHQs -- | The same as 'playSeqARV2', but additionally collects the resulting 'Bool' values and then returns them. It is used to define, which sounds from those of -- higher quality will replace those ones considered to be replaced. playCollectDec :: V.Vector String -> IO (V.Vector Bool) -playCollectDec vec = do - dirV3 <- listVDirectory +playCollectDec = playCollectDec2G "221w" + +-- | Generalized variant of the 'playCollectDec' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to +-- 'soxBasicParams'. +playCollectDec2G :: String -> V.Vector String -> IO (V.Vector Bool) +playCollectDec2G ys vec = do + dirV3 <- listVDirectory2G ys let indexesHQs = fst . last . infoFromV $ vec - V.mapM (playCollect1Dec dirV3) indexesHQs + V.mapM (playCollect1Dec dirV3) indexesHQs -- | Actually replaces the file represented by 'FilePath' argument with no (then there is no replacement at all), or with just one, -- or with a sequence of sounds being considered of higher quality to form a new melody. If the lengths of the second and the third -- arguments differs from each other then the function uses as these arguments truncated vectors of the minimal of the two lengths. replaceWithHQs :: FilePath -> V.Vector Bool -> V.Vector FilePath -> IO () -replaceWithHQs file0 vecBools stringHQs +replaceWithHQs = replaceWithHQs2G "221w" + +-- | Generalized variant of the 'replaceWithHQs' with a possibility to work either with FLAC files or with WAV files. +-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. +replaceWithHQs2G :: String -> FilePath -> V.Vector Bool -> V.Vector FilePath -> IO () +replaceWithHQs2G ys file0 vecBools stringHQs | V.length vecBools == V.length stringHQs = case V.length stringHQs of 0 -> putStrLn "That's all!" 1 | V.unsafeIndex vecBools 0 -> do - copyFile (head . V.toList $ stringHQs) "resultI.wav" - renameFile "resultI.wav" file0 + copyFile (head . V.toList $ stringHQs) ("resultI." ++ if drop 3 ys == "f" then "flac" else "wav") + renameFile ("resultI." ++ if drop 3 ys == "f" then "flac" else "wav") file0 | otherwise -> putStrLn "Nothing has changed. " _ -> do let yss = V.toList . V.ifilter (\i _ -> V.unsafeIndex vecBools i) $ stringHQs @@ -241,11 +334,11 @@ 0 -> putStrLn "That's all!" 1 -> copyFile (head yss) file0 _ -> do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (yss ++ [file0]) "" + (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (yss ++ soxBasicParams ys ["",file0]) "" putStrLn herr | otherwise = let stringHQ2s = V.take (min (V.length vecBools) (V.length stringHQs)) stringHQs - vecBool2s = V.take (min (V.length vecBools) (V.length stringHQs)) vecBools in replaceWithHQs file0 vecBool2s stringHQ2s + vecBool2s = V.take (min (V.length vecBools) (V.length stringHQs)) vecBools in replaceWithHQs2G ys file0 vecBool2s stringHQ2s -- | 'IO' checkbox whether to add the sound played to the sequence of sounds that will replace the needed one. thisOne :: IO Bool @@ -266,37 +359,116 @@ -- | Process the sound corresponding to the first element in the first argument. Returns a 'V.tail' of the first element of the first command line argument. -- Replaces (if specified) the sound with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality. pAnR1 :: V.Vector String -> IO (V.Vector String) -pAnR1 vec +pAnR1 = pAnR12G "221w" + +-- | Generalized variant of the 'pAnR1' with a possibility to work either with FLAC files or with WAV files. +-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. +pAnR12G :: String -> V.Vector String -> IO (V.Vector String) +pAnR12G ys vec | V.null vec = putStrLn "You have processed all the marked files! " >> return V.empty | otherwise = do let [(indexes0,strings),(indexesHQ,stringHQs)] = infoFromV vec putStrLn "Please, listen to the melody and remember what sound you would like to replace and the surrounding sounds. " - playSeqAR $ V.unsafeIndex indexes0 0 + playSeqAR2G ys $ V.unsafeIndex indexes0 0 putStrLn "---------------------------------------------------------------" putStrLn "Now, please, listen to a collection of sounds considered of higher quality which you can use to replace the needed one. " - vecBools <- playCollectDec vec - replaceWithHQs (V.unsafeIndex strings 0) vecBools stringHQs + vecBools <- playCollectDec2G ys vec + replaceWithHQs2G ys (V.unsafeIndex strings 0) vecBools stringHQs return $ V.map (\(ix,xs) -> show ix ++ "**" ++ xs) . V.zip (V.unsafeDrop 1 indexes0) $ (V.unsafeDrop 1 strings) --- | Process the sounds consequently corresponding to the elements in the first argument. +-- | Process the WAV sounds consequently corresponding to the elements in the first argument. -- Replaces (if specified) the sounds with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality for every sound needed. pAnR2 :: V.Vector String -> IO () -pAnR2 vec +pAnR2 = pAnR22G "221w" + +-- | Generalized variant of the 'pAnR2' with a possibility to work either with FLAC files or with WAV files. +-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. +pAnR22G :: String -> V.Vector String -> IO () +pAnR22G ys vec | V.null vec = putStrLn "You have processed all the marked files! " - | otherwise = onException (pAnR1 vec >>= pAnR2) (return ()) + | otherwise = onException (pAnR12G ys vec >>= pAnR22G ys) (return ()) --- | Marks the needed files as of needed to be replaced or those ones considered of higher quality that will replace the needed ones. Then actually replaces them +-- | Marks the needed WAV files as of needed to be replaced or those ones considered of higher quality that will replace the needed ones. Then actually replaces them -- as specified. Uses internally 'playAMrk' and 'pAnR2' functions. pAnR_ :: IO () -pAnR_ = do - vec <- playAMrk - pAnR2 vec +pAnR_ = pAnR_2G "221w" +-- | Generalized variant of the 'pAnR_' with a possibility to work either with FLAC files or with WAV files. +-- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. +pAnR_2G :: String -> IO () +pAnR_2G ys = do + vec <- playAMrk2G ys + pAnR22G ys vec + +-- | Converts WAV file to FLAC file using SoX (please, check before whether your installation supports FLAC files) using possible rate and bit depth +-- conversion accordingly to 'soxBasicParams' format. If the conversion is successful ('ExitCode' is 'ExitSuccess') then removes the primary file. +wavToFlac :: String -> FilePath -> IO () +wavToFlac ys file = do + let (ts,zs) = splitAt 2 . init $ ys + (code,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file,getBFst' ("-r22050",V.fromList . zip ["11","16", "17", "19", "32", "44", "48", + "80", "96"] $ ["-r11025","-r16000","-r176400","-r192000","-r32000","-r44100","-r48000","-r8000","-r96000"]) ts, if zs == "2" then "-b24" + else "-b16",take (length file - 3) file ++ "flac"] "" + case code of + ExitSuccess -> removeFile file + _ -> do + putStrLn $ "DobutokO.Sound.IntermediateF.wavToFlac: " ++ herr + exi <- doesFileExist $ take (length file - 3) file ++ "flac" + if exi then removeFile (take (length file - 3) file ++ "flac") >> error "" + else error "" + +-- | Converts FLAC file to WAV file using SoX (please, check before whether your installation supports FLAC files) using possible rate and bit depth +-- conversion accordingly to 'soxBasicParams' format. If the conversion is successful ('ExitCode' is 'ExitSuccess') then removes the primary file. +flacToWav :: String -> FilePath -> IO () +flacToWav ys file = do + let (ts,zs) = splitAt 2 . init $ ys + (code,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file,getBFst' ("-r22050",V.fromList . zip ["11","16", "17", "19", "32", "44", "48", + "80", "96"] $ ["-r11025","-r16000","-r176400","-r192000","-r32000","-r44100","-r48000","-r8000","-r96000"]) ts, if zs == "2" then "-b24" + else "-b16",take (length file - 4) file ++ "wav"] "" + case code of + ExitSuccess -> removeFile file + _ -> do + putStrLn $ "DobutokO.Sound.IntermediateF.flacToWav: " ++ herr + exi <- doesFileExist $ take (length file - 4) file ++ "wav" + if exi then removeFile (take (length file - 4) file ++ "wav") >> error "" + else error "" + +w2f :: FilePath -> FilePath +w2f file = let (zs,ts) = splitAt (length file - 4) file in if ts == ".wav" then zs ++ ".flac" else error "You give not a WAV file! " + +f2w :: FilePath -> FilePath +f2w file = let (zs,ts) = splitAt (length file - 5) file in if ts == ".flac" then zs ++ ".wav" else error "You give not a FLAC file! " + +wOrf :: FilePath -> String +wOrf file = + let (_,us) = splitAt (length file - 4) file in + case us of + ".wav" -> "w" + "flac" -> "f" + _ -> error "You give neither a WAV nor a FLAC file! " + +cfw2wf :: FilePath -> FilePath +cfw2wf file + | wOrf file == "w" = w2f file + | wOrf file == "f" = f2w file + | otherwise = error "You give neither a WAV nor a FLAC file! " + +efw2 :: FilePath -> String +efw2 file + | wOrf file == "w" = ".wav" + | wOrf file == "f" = ".flac" + | otherwise = error "You give neither a WAV nor a FLAC file! " + +efw2vv :: FilePath -> String +efw2vv file + | wOrf file == "w" = ".flac" + | wOrf file == "f" = ".wav" + | otherwise = error "You give neither a WAV nor a FLAC file! " + ---------------------------------------------------------------------------------------------------------------- -- | Takes a filename to be applied a SoX \"reverb" effect with parameters of list of 'String' (the second argument). Produces the temporary --- new file with the name ((name-of-the-file) ++ \"reverb.wav\"), which then is removed. Please, remember that for the mono audio --- the after applied function file is stereo with 2 channels. +-- new file with the name ((name-of-the-file) ++ (\"reverb.wav\" OR \"reverb.flac\") -- the type is preserved), which then is removed. +-- Please, remember that for the mono audio the after applied function file is stereo with 2 channels. -- -- Besides, you can specify other SoX effects after reverberation in a list of 'String'. The syntaxis is that every separate literal must be -- a new element in the list. If you plan to create again mono audio in the end of processment, then probably use 'reverb1E' funcion instead. @@ -305,52 +477,95 @@ -- file and to the containing it directory. The function is not intended to be used in otherwise cases. reverbE :: FilePath -> [String] -> IO () reverbE file arggs = do - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb.wav","reverb"] ++ arggs) "" + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb" ++ efw2 file,"reverb"] ++ arggs) "" case code of - ExitSuccess -> renameFile (file ++ "reverb.wav") file + ExitSuccess -> renameFile (file ++ "reverb" ++ efw2 file) file _ -> do - removeFile $ file ++ "reverb.wav" - putStrLn $ "DobutokO.Sound.IntermediateF.reverbE: file \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + removeFile $ file ++ "reverb" ++ efw2 file + putStrLn $ "DobutokO.Sound.IntermediateF.reverbE \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " --- | The same as 'reverbE', but at the end file is being mixed to obtain mono audio. The name of the temporary file is ((name-of-the-file) ++ \"reverb1.wav\"). +-- | Similar to 'reverbE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another +-- extension and type. +reverbE2C :: FilePath -> [String] -> IO () +reverbE2C file arggs = do + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb" ++ efw2vv file,"reverb"] ++ arggs) "" + case code of + ExitSuccess -> do { renameFile (file ++ "reverb" ++ efw2vv file) (cfw2wf file) ; removeFile file } + _ -> do { removeFile $ file ++ "reverb" ++ efw2vv file + ; putStrLn $ "DobutokO.Sound.IntermediateF.reverbE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " } + +-- | The same as 'reverbE', but at the end file is being mixed to obtain mono audio. The name of the temporary file is ((name-of-the-file) ++ +-- (\"reverb1.wav\" OR \"reverb1.flac\") -- the type is preserved). -- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. reverb1E :: FilePath -> [String] -> IO () reverb1E file arggs = do - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb1.wav","reverb"] ++ arggs ++ ["channels","1"]) "" + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb1" ++ efw2 file,"reverb"] ++ arggs ++ ["channels","1"]) "" case code of - ExitSuccess -> renameFile (file ++ "reverb1.wav") file + ExitSuccess -> renameFile (file ++ "reverb1" ++ efw2 file) file _ -> do - removeFile $ file ++ "reverb1.wav" - putStrLn $ "DobutokO.Sound.IntermediateF.reverb1E: file \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + removeFile $ file ++ "reverb1" ++ efw2 file + putStrLn $ "DobutokO.Sound.IntermediateF.reverb1E \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " +-- | Similar to 'reverb1E', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another +-- extension and type. +reverb1E2C :: FilePath -> [String] -> IO () +reverb1E2C file arggs = do + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb1" ++ efw2vv file,"reverb"] ++ arggs ++ ["channels","1"]) "" + case code of + ExitSuccess -> do { renameFile (file ++ "reverb1" ++ efw2vv file) (cfw2wf file) ; removeFile file } + _ -> do + removeFile $ file ++ "reverb1" ++ efw2vv file + putStrLn $ "DobutokO.Sound.IntermediateF.reverb1E2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + -- | The same as 'reverbE', but uses \"reverb -w\" effect instead of \"reverb\". The name of the temporary file is --- ((name-of-the-file) ++ \"reverbW.wav\"). Please, for more information, refer to SoX documentation. +-- ((name-of-the-file) ++ (\"reverbW.wav\" OR \"reverbW.flac\") -- the type is preserved). Please, for more information, refer to SoX documentation. -- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. reverbWE :: FilePath -> [String] -> IO () reverbWE file arggs = do - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW.wav","reverb","-w"] ++ arggs) "" + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW" ++ efw2 file,"reverb","-w"] ++ arggs) "" case code of - ExitSuccess -> renameFile (file ++ "reverbW.wav") file + ExitSuccess -> renameFile (file ++ "reverbW" ++ efw2 file) file _ -> do - removeFile $ file ++ "reverbW.wav" - putStrLn $ "DobutokO.Sound.IntermediateF.reverbWE: file \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + removeFile $ file ++ "reverbW" ++ efw2 file + putStrLn $ "DobutokO.Sound.IntermediateF.reverbWE \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " +-- | Similar to 'reverbWE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another +-- extension and type. +reverbWE2C :: FilePath -> [String] -> IO () +reverbWE2C file arggs = do + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW" ++ efw2vv file,"reverb","-w"] ++ arggs) "" + case code of + ExitSuccess -> do { renameFile (file ++ "reverbW" ++ efw2vv file) (cfw2wf file) ; removeFile file } + _ -> do { removeFile $ file ++ "reverbW" ++ efw2vv file + ; putStrLn $ "DobutokO.Sound.IntermediateF.reverbWE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " } + -- | The same as 'reverbWE', but at the end file is being mixed to obtain mono audio. The name of the temporary file is ((name-of-the-file) --- ++ \"reverbW1.wav\"). Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified --- file and to the containing it directory. The function is not intended to be used in otherwise cases. +-- ++ (\"reverbW1.wav\" OR \"reverbW1.flac\") -- the type is preserved). Please, check by yourself whether you have enough permissions +-- to read and write to the 'FilePath'-specified file and to the containing it directory. The function is not intended to be used in otherwise cases. reverbW1E :: FilePath -> [String] -> IO () reverbW1E file arggs = do - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW1.wav","reverb","-w"] ++ arggs ++ ["channels","1"]) "" + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW1" ++ efw2 file,"reverb","-w"] ++ arggs ++ ["channels","1"]) "" case code of - ExitSuccess -> renameFile (file ++ "reverbW1.wav") file + ExitSuccess -> renameFile (file ++ "reverbW1" ++ efw2 file) file _ -> do - removeFile $ file ++ "reverbW1.wav" - putStrLn $ "DobutokO.Sound.IntermediateF.reverbW1E: file \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + removeFile $ file ++ "reverbW1" ++ efw2 file + putStrLn $ "DobutokO.Sound.IntermediateF.reverbW1E \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " +-- | Similar to 'reverb1WE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another +-- extension and type. +reverb1WE2C :: FilePath -> [String] -> IO () +reverb1WE2C file arggs = do + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW1" ++ efw2vv file,"reverb","-w"] ++ arggs ++ ["channels","1"]) "" + case code of + ExitSuccess -> do { renameFile (file ++ "reverbW1" ++ efw2vv file) (cfw2wf file) ; removeFile file } + _ -> do + removeFile $ file ++ "reverbW1" ++ efw2vv file + putStrLn $ "DobutokO.Sound.IntermediateF.reverb1WE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + -- | Takes a filename to be applied a SoX chain of effects (or just one) as list of 'String' (the second argument). Produces the temporary --- new file with the name ((name-of-the-file) ++ \"effects.wav\"), which then is removed. +-- new file with the name ((name-of-the-file) ++ (\"effects.wav\" OR \"effects.flac\") -- the type is preserved), which then is removed. -- -- The syntaxis is that every separate literal for SoX must be a new element in the list. If you plan to create again mono audio in the end of processment, -- then probably use 'soxE1' function instead. Please, for more information, refer to SoX documentation. @@ -358,24 +573,46 @@ -- file and to the containing it directory. The function is not intended to be used in otherwise cases. soxE :: FilePath -> [String] -> IO () soxE file arggs = do - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects.wav"] ++ arggs) "" + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2 file] ++ arggs) "" case code of - ExitSuccess -> renameFile (file ++ "effects.wav") file + ExitSuccess -> renameFile (file ++ "effects" ++ efw2 file) file _ -> do - removeFile $ file ++ "effects.wav" - putStrLn $ "DobutokO.Sound.IntermediateF.soxE: file \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + removeFile $ file ++ "effects" ++ efw2 file + putStrLn $ "DobutokO.Sound.IntermediateF.soxE \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " +-- | Similar to 'soxE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another +-- extension and type. +soxE2C :: FilePath -> [String] -> IO () +soxE2C file arggs = do + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2vv file] ++ arggs) "" + case code of + ExitSuccess -> do { renameFile (file ++ "effects" ++ efw2vv file) (cfw2wf file) ; removeFile file } + _ -> do + removeFile $ file ++ "effects" ++ efw2vv file + putStrLn $ "DobutokO.Sound.IntermediateF.soxE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + -- | The same as 'soxE', but at the end file is being mixed to obtain mono audio. -- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. soxE1 :: FilePath -> [String] -> IO () soxE1 file arggs = do - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects.wav"] ++ arggs ++ ["channels","1"]) "" + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2 file] ++ arggs ++ ["channels","1"]) "" case code of - ExitSuccess -> renameFile (file ++ "effects.wav") file + ExitSuccess -> renameFile (file ++ "effects" ++ efw2 file) file _ -> do - removeFile $ file ++ "effects.wav" - putStrLn $ "DobutokO.Sound.IntermediateF.soxE1: file \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + removeFile $ file ++ "effects" ++ efw2 file + putStrLn $ "DobutokO.Sound.IntermediateF.soxE1 \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " + +-- | Similar to 'soxE1', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another +-- extension and type. +soxE12C :: FilePath -> [String] -> IO () +soxE12C file arggs = do + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2vv file] ++ arggs ++ ["channels","1"]) "" + case code of + ExitSuccess -> do { renameFile (file ++ "effects" ++ efw2vv file) (cfw2wf file) ; removeFile file } + _ -> do + removeFile $ file ++ "effects" ++ efw2vv file + putStrLn $ "DobutokO.Sound.IntermediateF.soxE12C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Function takes a 'FilePath' for the new recorded file (if it already exists then it is overwritten) and a list of 'String'. The last one is -- sent to SoX rec or something equivalent as its arguments after the filename. If you plan just afterwards to produce mono audio, it's simpler to use diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -19,6 +19,10 @@ dobutokO2 { 8 | 80 | 9 | 99 | 999 } +OR: + +dobutokO2 { 82 | 820 | 92 | 992 | 9992 } {volatile symbols together, e. g. "0"} {quality control, see information below} + where filename is: the full name of the file to be recorded in the current directory or the full absolute path to the sound .wav file (or other one format @@ -140,7 +144,34 @@ repeat all the process of creation of "result\*" files. Be aware and use with care! + "82" -> the same as "8", but you can specify the sound quality parameters for the + resulted file and choose whether it will be in WAV or FLAC format. To specify + this additional processing information, use as a third command line argument + (after the first "82" and the volatile second one) 4 consequent symbols: + 3 digits and 1 letter ('f' -- for FLAC one and 'w' for WAV one). The first + two digits are a code for rate and the third one -- a code for bit depth + ('1' -- for 16 bit and '2' -- for 24 bit). The list of possible first + two digits and their corresponding frequency rate in Hz: + "11" -> 11025 + "16" -> 16000 + "17" -> 176400 + "19" -> 192000 + "32" -> 32000 + "44" -> 44100 + "48" -> 48000 + "80" -> 8000 + "96" -> 96000 + The default one behaviour is equivalent to "221w". + + "820" -> the same as "80", but similarly to "82" it gives you the opportunity to + specify sound quality parameters in just the same way. + "9", "99", or "999" -> see the information above. + + "92", "992", or "9992" -> similar to the above line, but with the opportunity to + specify sound quality parameters in just the same way as for "82" option. + These are considered still highly experimental and not well tested, + so use them not for production. _ -> the program behaves like for the "5" option, but generates overtones using additional String and allows maximum control over @@ -168,6 +199,11 @@ possibility to adjust volume for the overtones using generalized functions '1G' with adjustment being represented in dB. For more information, please, refer to the documentation for the DobutokO.Sound.Functional module. + +Since the 0.23.0.0 version the library includes functions '2G': generalized +ones in the DobutokO.Sound.Functional, and DobutokO.Sound.IntermediateF, and +DobutokO.Sound.Executable modules. They allow to specify sound quality +of the resulting files using additional parameter. ** Note: diff --git a/dobutokO2.cabal b/dobutokO2.cabal --- a/dobutokO2.cabal +++ b/dobutokO2.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: dobutokO2 -version: 0.22.1.0 +version: 0.23.0.0 synopsis: A program and a library to create experimental music from a mono audio and a Ukrainian text description: It can also create a timbre for the notes. Uses SoX inside. homepage: https://hackage.haskell.org/package/dobutokO2