module Processing_mmsyn7ukr where
import System.Directory
import Control.Exception (bracketOnError, onException)
import EndOfExe (showE)
import Data.Maybe (fromJust)
import Data.Char
import Data.List (isSuffixOf)
import qualified Data.Vector as V
import System.Process
import System.IO
import SoXBasics
import Melodics.Ukrainian (appendS16LEFile, convertToProperUkrainian)
import UkrainianLControl
import CaseBi (getBFst')
produceSound :: FilePath -> IO ()
produceSound file = let file1 = drop (length file - 5) file in do
let soundUkr = getBFst' ("е", V.fromList . zip ["A.wav", "B.wav", "C.wav", "D.wav", "E.wav", "F.wav", "G.wav", "H.wav",
"I.wav", "J.wav", "K.wav", "L.wav", "M.wav", "N.wav", "O.wav", "P.wav", "Q.wav", "R.wav",
"S.wav", "T.wav", "U.wav", "V.wav", "W.wav", "X.wav", "Y.wav", "Z.wav", "a.wav", "b.wav", "c.wav",
"d.wav", "e.wav", "f.wav"] $ ["а", "б", "в", "г", "д", "дж", "дз", "е", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р",
"с", "сь", "т", "у", "ф", "х", "ц", "ць", "ч", "ш", "ь", "і", "ґ"]) $ file1
putStr "The needed files were not created, because the sound was not at the moment of recording! The process will be restarted "
putStrLn "for the sound. Please, produce a sound during the first 3 seconds (after 0.5 second delay) or specify greater ratio!"
playA file
longerK0 <- tempS soundUkr
(_, Just hout, _, _) <- createProcess (proc (fromJust . showE $ "soxi") ["-D", file]) { std_out = CreatePipe }
x3 <- hGetContents hout
let longerK = (read x3::Double)*longerK0
putStrLn $ "Please, now pronounce the sound representation of the " ++ soundUkr ++ " sound or whatever you would like to be substituted (be sensible, please)! "
if (compare (7*longerK) 3.0 == LT)
then recA "x.wav" (7*longerK)
else recA "x.wav" 3.0
putStrLn "The file is recorded and now will be automatically processed. You will be notificated with the text message in the terminal about the creation of the needed file. Please, wait a little. "
norm "x.wav"
noiseProfB "8x.wav"
noiseReduceB "8x.wav"
lim0 <- durationA "_8x.wav"
alterVadB "_8x.wav" lim0
lim1 <- durationA "7_8x.wav"
if lim1 <= 0.0
then beginProcessing file file1 soundUkr
else do
alterVadE "7_8x.wav" lim1
sincA "67_8x.wav"
resampleA "4.67_8x.wav" (22050::Int)
quarterSinFade "34.67_8x.wav"
norm "434.67_8x.wav"
volS2 "8434.67_8x.wav" file
renameFile "8.434.67_8x.wav" file1
cleanTemp
beginProcessing :: FilePath -> FilePath -> String -> IO ()
beginProcessing file file1 soundUkr = do
cleanTemp
putStr "The needed files were not created, because the sound was not at the moment of recording! The process will be restarted "
putStrLn "for the sound. Please, produce a sound during the first 3 seconds (after 0.5 second delay) or specify greater ratio!"
putStrLn $ "Listen to the \"" ++ soundUkr ++ "\" sound and note first of all its duration. "
playA file
longerK0 <- tempS soundUkr
(_, Just hout, _, _) <- createProcess (proc (fromJust . showE $ "soxi") ["-D", file]) { std_out = CreatePipe }
x3 <- hGetContents hout
let longerK = (read x3::Double)*longerK0
putStrLn $ "Please, now pronounce the sound representation of the " ++ soundUkr ++ " sound or whatever you would like to be substituted (be sensible, please)! "
if (compare (7*longerK) 3.0 == LT)
then recA "x.wav" (7*longerK)
else recA "x.wav" 3.0
putStrLn "The file is recorded and now will be automatically processed. You will be notificated with the text message in the terminal about the creation of the needed file. Please, wait a little. "
norm "x.wav"
noiseProfB "8x.wav"
noiseReduceB "8x.wav"
lim0 <- durationA "_8x.wav"
alterVadB "_8x.wav" lim0
lim1 <- durationA "7_8x.wav"
if lim1 <= 0.0
then beginProcessing file file1 soundUkr
else do
alterVadE "7_8x.wav" lim1
sincA "67_8x.wav"
resampleA "4.67_8x.wav" (22050::Int)
quarterSinFade "34.67_8x.wav"
norm "434.67_8x.wav"
volS2 "8434.67_8x.wav" file
renameFile "8.434.67_8x.wav" file1
cleanTemp
tempS :: String -> IO Double
tempS soundUkr = onException (do
putStrLn $ "In how many times do you think your sound representing " ++ soundUkr ++ " will sound longer than the recently played one? Specify as a Double value without \"e\" notation. "
longivityY <- getLine
let long = read longivityY::Double in return long) (do
putStrLn "Please, specify the value of the Double type!"
tempS soundUkr)
cleanCreatedSoundFs :: IO ()
cleanCreatedSoundFs = do
dirCs <- listDirectory "."
let remFs = concatMap (\ys -> filter (\zs -> ys `isSuffixOf` zs) dirCs) [".raw", ".wav", ".ogg", ".flac"] in mapM_ removeFile remFs
createAndPlayFs :: IO ()
createAndPlayFs = do
putStrLn "Next file can be now voiced by your \"voice\". If you would like to run a new round and create a new speech, enter \"y\" as text input now!"
putStrLn "Otherwise, the program will end and remove all your sound files in the current directory created with your voice during the program execution time."
choice <- getLine
if take 1 choice == "y"
then do
main6Ukr
createAndPlayFs
else return ()
main6Ukr :: IO ()
main6Ukr = bracketOnError (do
putStrLn "Please, specify the arguments to control the output speech file! "
putStrLn "See https://hackage.haskell.org/package/mmsyn6ukr-0.6.0.0/docs/UkrainianLControl.html#v:genControl for more information."
putStrLn "You can specify e. g. \"o9-1\" or \"o5-1\" or other options."
arg <- getLine
let args = take 1 . words $ arg in do
putStrLn "Please, specify the name of the resulting sound file! Please, do NOT use '}' character and space or control characters!"
nameOfSoundFile <- getLine
let nameSF = filter (\x -> not (isSpace x) && not (isControl x) && x /= '}') nameOfSoundFile in
return (args, nameSF)) (\(args, nameSF) -> do
putStr $ "Notice, there was (may be) CmdLineArgument exception. To avoid it, please, specify the command line argument (if needed) in the form \"ABC\""
putStrLn $ " where A is either a letter \'f\', \'o\', \'w\' or a digit and B and C are both digits! The exception (may be) arose from the command line arguments "
++ show args ++ " for the file: " ++ show nameSF ++ ". Please, check also whether the SoX was installed with the support for needed codec.") (\(args, nameSF) -> do
xs <- getContents
let ys = take (nSymbols (let zs = take 1 args in if null zs then [] else fst . genControl . head $ zs)) xs in
withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFile (convertToProperUkrainian ys))
putStrLn "The .raw file was created by the program. It will be processed further. "
let ts = fromJust (showE "sox") in do
_ <- readProcessWithExitCode ts ["r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw",
fst . snd . genControl . concat $ args, nameSF ++ (snd . snd . genControl . concat $ args)] ""
removeFile $ nameSF ++ ".raw"
putStrLn "Would you like to play the resulting file now?"
pls <- getLine
if take 1 pls == "y" || take 1 pls == "Y"
then playA $ nameSF ++ (snd . snd . genControl . concat $ args)
else return ())