-- | -- Module : DobutokO.Sound.Functional -- Copyright : (c) OleksandrZhabenko 2020 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- A program and a library to create experimental music -- from a mono audio and a Ukrainian text. {-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -threaded #-} module DobutokO.Sound.Functional ( -- * Use additional function as a parameter oberSoXSynth2FDN , oberSoXSynth2FDN_B -- ** Just simple function application , oberSoXSynth2FDN_S -- *** With additional filtering , oberSoXSynth2FDN_Sf , oberSoXSynth2FDN_Sf3 -- * Use additional function and Ukrainian texts and generates melody , oberSoXSynthGen2FDN , oberSoXSynthGen2FDN_B , oberSoXSynthGen2FDN_S , oberSoXSynthGen2FDN_Sf , oberSoXSynthGen2FDN_Sf3 ) where import Data.Char (isDigit) import System.Exit (ExitCode( ExitSuccess )) import Numeric import Data.List (isPrefixOf,sort,sortBy,nubBy) import Data.Maybe (isNothing,fromJust) import qualified Data.Vector as V import System.Process import EndOfExe import System.Directory import Melodics.Ukrainian import SoXBasics (durationA) import DobutokO.Sound hiding (oberSoXSynth2FDN) -- | Similar to 'oberSoXSynth2DN' but instead of 'oberTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with -- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is an experimental feature, so -- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the -- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. 'Int' argument is an index of the element to be taken from -- the 'intervalsFromString' applied to the 'String' argument. To obtain compatible with versions prior to 0.20.0.0 behaviour, use for the 'Int' 0. -- -- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. -- But for a lot of functions this works well. -- -- It is recommended to fully simplify the computation for \"f\" function before using it in the 'oberSoXSynth2FDN'. oberSoXSynth2FDN :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> Int -> String -> IO () oberSoXSynth2FDN f (x, y) j zs | V.null . convertToProperUkrainian $ zs = oberSoXSynth 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 (fromIntegral 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 = if isNothing note1 then V.empty else g . fromJust $ note1 ts = showFFloat (Just 4) (abs y) $ show 0 oberSoXSynthHelp vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-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 oberSoXSynthHelp2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-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] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) note0 $ show 0] "" if isNothing note1 then do oberSoXSynthHelp v0 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0] "" oberSoXSynthHelp v0 oberSoXSynthHelp2 v1 paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" mapM_ removeFile paths -- | 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 -- basic sound duration, it defines tempo of the melody in general. oberSoXSynthGen2FDN :: FilePath -> Int -> Int -> (Double -> V.Vector (Double, Double)) -> Double -> String -> String -> IO () oberSoXSynthGen2FDN file m ku f y zs wws = do duration0 <- durationA file let n = truncate (duration0 / 0.001) vecA <- V.generateM n (\k -> do { (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat (Just 4) (fromIntegral k * 0.001) $ show 0, "0.001", "stat"] "" ; let line0s = lines herr noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s ; if null noteN0 then return (11440::Int) else let noteN1 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) 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 oberSoXSynth2FDN f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB path2s <- listDirectory "." let paths3 = sort . filter (isPrefixOf "result") $ path2s (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" case code of ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " _ -> do 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." -- | Similar to 'oberSoXSynth2DN' but instead of 'oberTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with -- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is experimental feature, so -- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the -- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. The function also tries to perform filtering to avoid possible beating. -- The third 'Double' parameter in the tuple is used as a limit for frequencies difference in Hz to be filtered out from the resulting sound. It is -- considered to be from the range @[0.1..10.0]@. An 'Int' parameter is used to define the needed interval. To obtain compatible with versions prior -- to 0.20.0.0 behaviour, use for the 'Int' 0. -- -- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. -- But for a lot of functions this works well. -- -- It is recommended to fully simplify the computation for \"f\" function before using it in the 'oberSoXSynth2FDN_B'. oberSoXSynth2FDN_B :: (Double -> V.Vector (Double, Double)) -> (Double, Double, Double) -> Int -> String -> IO () oberSoXSynth2FDN_B f (x, y, limB) j zs | V.null . convertToProperUkrainian $ zs = oberSoXSynth x | otherwise = do let limA0 = abs ((limB / fromIntegral 10) - (fromIntegral . truncate $ (limB / fromIntegral 10))) * fromIntegral 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 (fromIntegral 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 = if isNothing note1 then V.empty else g . fromJust $ note1 ts = showFFloat (Just 4) (abs y) $ show 0 oberSoXSynthHelp vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-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 oberSoXSynthHelp2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-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] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) note0 $ show 0] "" if isNothing note1 then do oberSoXSynthHelp v0 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0] "" oberSoXSynthHelp v0 oberSoXSynthHelp2 v1 paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" mapM_ removeFile paths -- | 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 -- basic sound duration, it defines tempo of the melody in general. The second one is a limit for frequencies difference in Hz to be filtered out from the -- resulting sound. It is considered to be from the range @[0.1..10.0]@. oberSoXSynthGen2FDN_B :: FilePath -> Int -> Int -> (Double -> V.Vector (Double, Double)) -> Double -> Double -> String -> String -> IO () oberSoXSynthGen2FDN_B file m ku f y limB zs wws = do duration0 <- durationA file let n = truncate (duration0 / 0.001) vecA <- V.generateM n (\k -> do { (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat (Just 4) (fromIntegral k * 0.001) $ show 0, "0.001", "stat"] "" ; let line0s = lines herr noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s ; if null noteN0 then return (11440::Int) else let noteN1 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) 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 oberSoXSynth2FDN_B f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), limB) j wws renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB path2s <- listDirectory "." let paths3 = sort . filter (isPrefixOf "result") $ path2s (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" case code of ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " _ -> do 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." -- | Similar to 'oberSoXSynth2FDN' but it does not make any normalizing transformations with the 'V.Vector' argument. To be used properly, it is needed -- that every second element in the tuple in the 'V.Vector' argument must be in the range [-1.0..1.0] and every first element must be in between -- 16.351597831287414 and 7902.132820097988 (Hz). An 'Int' parameter is used to define an interval. To obtain compatible with versions prior to -- 0.20.0.0 behaviour, use for the 'Int' 0. -- -- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. -- But for a lot of functions this works well. -- -- It is recommended to fully simplify the computation for \"f\" function before using it in the 'oberSoXSynth2FDN_S'. oberSoXSynth2FDN_S :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> Int -> String -> IO () oberSoXSynth2FDN_S f (x, y) j zs | V.null . convertToProperUkrainian $ zs = oberSoXSynth 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 = if isNothing note1 then V.empty else f . fromJust $ note1 ts = showFFloat (Just 4) (abs y) $ show 0 oberSoXSynthHelp vec = let l = V.length vec zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0 then do path1s <- listDirectory "." let path2s = sort . filter (isPrefixOf "test0") $ path1s (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) "" case code of ExitSuccess -> mapM_ removeFile path2s _ -> do exi <- doesFileExist $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav" if exi then putStrLn ("Line 161: " ++ herr0) >> removeFile ("test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav") else putStrLn $ "Line 162: " ++ herr0 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" return ()) vec oberSoXSynthHelp2 vec = let l = V.length vec zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0 then do path3s <- listDirectory "." let path4s = sort . filter (isPrefixOf "test1") $ path3s (code2,_,herr2) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path4s ++ ["test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) "" case code2 of ExitSuccess -> mapM_ removeFile path4s _ -> do exi <- doesFileExist $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav" if exi then putStrLn ("Line 177: " ++ herr2) >> removeFile ("test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav") else putStrLn $ "Line 178: " ++ herr2 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" return ()) vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) note0 $ show 0] "" if isNothing note1 then do oberSoXSynthHelp v0 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0] "" oberSoXSynthHelp v0 oberSoXSynthHelp2 v1 paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" mapM_ removeFile paths -- | Similar to 'oberSoXSynthGen2FDN', but instead of 'oberSoXSynth2FDN' uses 'oberSoXSynth2FDN_S' function. oberSoXSynthGen2FDN_S :: FilePath -> Int -> Int -> (Double -> V.Vector (Double, Double)) -> Double -> String -> String -> IO () oberSoXSynthGen2FDN_S file m ku f y zs wws = do duration0 <- durationA file let n = truncate (duration0 / 0.001) vecA <- V.generateM n (\k -> do { (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat (Just 4) (fromIntegral k * 0.001) $ show 0, "0.001", "stat"] "" ; let line0s = lines herr noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s ; if null noteN0 then return (11440::Int) else let noteN1 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) 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 oberSoXSynth2FDN_S f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB path2s <- listDirectory "." let paths3 = sort . filter (isPrefixOf "result") $ path2s (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" case code of ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " _ -> do 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." -- | Similar to 'oberSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller -- by absolute value than 0.001. An 'Int' parameter is used to define an interval. To obtain compatible with versions prior to -- 0.20.0.0 behaviour, use for the 'Int' 0. -- -- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. -- But for a lot of functions this works well. -- -- It is recommended to fully simplify the computation for \"f\" function before using it in the 'oberSoXSynth2FDN_Sf'. oberSoXSynth2FDN_Sf :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> Int -> String -> IO () oberSoXSynth2FDN_Sf f (x, y) j zs | V.null . convertToProperUkrainian $ zs = oberSoXSynth 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 = V.filter (\(_,!z) -> compare (abs z) 0.001 == GT) . f $ note0 v1 = if isNothing note1 then V.empty else V.filter (\(_,!z) -> compare z 0.001 == GT) . f . fromJust $ note1 ts = showFFloat (Just 4) (abs y) $ show 0 oberSoXSynthHelp vec = let l = V.length vec zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0 then do path1s <- listDirectory "." let path2s = sort . filter (isPrefixOf "test0") $ path1s (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) "" case code of ExitSuccess -> mapM_ removeFile path2s _ -> do exi <- doesFileExist $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav" if exi then putStrLn ("Line 224: " ++ herr0) >> (removeFile $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav") else putStrLn $ "Line 225: " ++ herr0 else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec oberSoXSynthHelp2 vec = let l = V.length vec zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0 then do path3s <- listDirectory "." let path4s = sort . filter (isPrefixOf "test1") $ path3s (code,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path4s ++ ["test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) "" case code of ExitSuccess -> mapM_ removeFile path4s _ -> do exi <- doesFileExist $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav" if exi then putStrLn ("Line 239: " ++ herr1) >> (removeFile $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav") else putStr $ "Line 240: " ++ herr1 else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) note0 $ show 0] "" if isNothing note1 then do oberSoXSynthHelp v0 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0] "" oberSoXSynthHelp v0 oberSoXSynthHelp2 v1 paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" mapM_ removeFile paths -- | Similar to 'oberSoXSynthGen2FDN_S', but instead of 'oberSoXSynth2FDN_S' uses 'oberSoXSynth2FDN_Sf' function. oberSoXSynthGen2FDN_Sf :: FilePath -> Int -> Int -> (Double -> V.Vector (Double, Double)) -> Double -> String -> String -> IO () oberSoXSynthGen2FDN_Sf file m ku f y zs wws = do duration0 <- durationA file let n = truncate (duration0 / 0.001) vecA <- V.generateM n (\k -> do { (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat (Just 4) (fromIntegral k * 0.001) $ show 0, "0.001", "stat"] "" ; let line0s = lines herr noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s ; if null noteN0 then return (11440::Int) else let noteN1 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) 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 oberSoXSynth2FDN_Sf f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB path2s <- listDirectory "." let paths3 = sort . filter (isPrefixOf "result") $ path2s (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" case code of ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " _ -> do 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." -- | Similar to 'oberSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller -- than the third 'Double' parameter by an absolute value in the triple of @Double@'s. An 'Int' parameter is used to define an interval. To obtain compatible -- with versions prior to 0.20.0.0 behaviour, use for the 'Int' 0. -- -- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. -- But for a lot of functions this works well. -- -- It is recommended to fully simplify the computation for \"f\" function before using it in the 'oberSoXSynth2FDN_Sf3'. oberSoXSynth2FDN_Sf3 :: (Double -> V.Vector (Double, Double)) -> (Double, Double, Double) -> Int -> String -> IO () oberSoXSynth2FDN_Sf3 f (x, y, t0) j zs | V.null . convertToProperUkrainian $ zs = oberSoXSynth 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 = V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f $ note0 v1 = if isNothing note1 then V.empty else V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f . fromJust $ note1 ts = showFFloat (Just 4) (abs y) $ show 0 oberSoXSynthHelp vec = let l = V.length vec zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0 then do path1s <- listDirectory "." let path2s = sort . filter (isPrefixOf "test0") $ path1s (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) "" case code of ExitSuccess -> mapM_ removeFile path2s _ -> do exi <- doesFileExist $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav" if exi then putStrLn ("Line 285: " ++ herr0) >> (removeFile $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav") else putStrLn $ "Line 286: " ++ herr0 else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec oberSoXSynthHelp2 vec = let l = V.length vec zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0 then do path3s <- listDirectory "." let path4s = sort . filter (isPrefixOf "test1") $ path3s (code,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path4s ++ ["test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) "" case code of ExitSuccess -> mapM_ removeFile path4s _ -> do exi <- doesFileExist $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav" if exi then putStrLn ("Line 300: " ++ herr1) >> (removeFile $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav") else putStrLn $ "Line 301: " ++ herr1 else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) note0 $ show 0] "" if isNothing note1 then do oberSoXSynthHelp v0 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine", showFFloat (Just 4) (fromJust note1) $ show 0] "" oberSoXSynthHelp v0 oberSoXSynthHelp2 v1 paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" mapM_ removeFile paths -- | Similar to 'oberSoXSynthGen2FDN_S', but instead of 'oberSoXSynth2FDN_S' uses 'oberSoXSynth2FDN_Sf3' function. oberSoXSynthGen2FDN_Sf3 :: FilePath -> Int -> Int -> (Double -> V.Vector (Double, Double)) -> Double -> Double -> String -> String -> IO () oberSoXSynthGen2FDN_Sf3 file m ku f y t0 zs wws = do duration0 <- durationA file let n = truncate (duration0 / 0.001) vecA <- V.generateM n (\k -> do { (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat (Just 4) (fromIntegral k * 0.001) $ show 0, "0.001", "stat"] "" ; let line0s = lines herr noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s ; if null noteN0 then return (11440::Int) else let noteN1 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) 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 oberSoXSynth2FDN_Sf3 f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB path2s <- listDirectory "." let paths3 = sort . filter (isPrefixOf "result") $ path2s (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" case code of ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " _ -> do 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."