mmsyn7ukr-array-0.2.0.0: Processing_mmsyn7ukr_array.hs
-- |
-- Module : Processing_mmsyn7ukr
-- Copyright : (c) OleksandrZhabenko 2019-2022
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- A program and a library that can be used as a simple
-- basic interface to some SoX functionality or for producing
-- the approximately Ukrainian speech with your own recorded
-- voice (actually it produces the needed sound representations).
--
module Processing_mmsyn7ukr_array (
-- * Producing sound
produceSound2
, produceSound3
, produceSound4
, beginProcessing
, controlNoiseReduction
-- * Additional functions
, tempS
, showCoef
, tempeRa
, recommendSharp
-- * Cleaning
, cleanTemp
, cleanTempN
) where
import Control.Concurrent (threadDelay)
import Data.Typeable
import Numeric
import System.Directory
import Control.Exception (onException)
import EndOfExe (showE)
import Data.Maybe (fromJust)
import Data.Char
import qualified Data.List as L
import qualified Control.Monad as CM
import System.Process
import System.IO
import System.Info (os)
import System.Environment (getProgName)
import System.Exit
import Sound.SoXBasics
import CaseBi.Arr (getBFst')
import GHC.Arr
import Parser.ReplaceP (replaceP, replaceP4)
import Sound.Control.Exception.FinalException
import SoXBasics.Arr (recA,recB,playA)
-- | Function 'produceSound3' is used internally in the 'produceSound2' function.
produceSound3 :: (String, String) -> (FilePath, FilePath) -> String -> (Int, Float) -> Float -> IO ()
produceSound3 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0
| actsctrl == "-1" = prodSnd3H (actsctrl, noiseLim) (file, file1) soundUkr
| take 1 actsctrl == "0" = prodSnd3H (actsctrl, noiseLim) (file, file1) soundUkr
| take 1 actsctrl == "1" = do
prodSnd3H2 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0 >>= \lim1 ->
if lim1 <= 0.0 then return () else resampleA "8_x.wav" (22050::Int) >> produceSound4 (file, file1) "38_x.wav"
| take 1 actsctrl == "2" = do
prodSnd3H2 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0 >>= \lim1 ->
if lim1 <= 0.0 then return () else sincA "8_x.wav" >> resampleA "4.8_x.wav" (22050::Int) >> produceSound4 (file, file1) "34.8_x.wav"
| otherwise = do
prodSnd3H2 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0 >>= \lim1 ->
if lim1 <= 0.0 then return () else sincA "8_x.wav" >> resampleA "4.8_x.wav" (22050::Int) >> quarterSinFade "34.8_x.wav" >>
produceSound4 (file, file1) "434.8_x.wav"
prodSnd3H :: (String, String) -> (FilePath, FilePath) -> String -> IO ()
prodSnd3H (actsctrl, noiseLim) (file, file1) soundUkr = do
lim1 <- durationA "8_x.wav"
if lim1 <= 0.0
then beginProcessing (file, file1) soundUkr (actsctrl, noiseLim)
else do
resampleA "8_x.wav" (22050::Int)
produceSound4 (file, file1) "38_x.wav"
prodSnd3H2 :: (String, String) -> (FilePath, FilePath) -> String -> (Int, Float) -> Float -> IO Float
prodSnd3H2 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0 = do
alterVadB "8_x.wav" lim0 noiseMax (duration0*0.03)
lim1 <- durationA "8_x.wav"
if lim1 <= 0.0
then beginProcessing (file, file1) soundUkr (actsctrl, noiseLim)
else alterVadE "8_x.wav" lim1 noiseMax (duration0*0.03)
return lim1
-- | Function 'produceSound4' is used internally in the 'produceSound3' function for amplification
-- up/down to the maximum level of the first @FilePath@ parameter in the tuple. The second one gives
-- a name of the resulting file and the third @FilePath@ parameter of the function is the @FilePath@ for
-- the input file.
produceSound4 :: (FilePath, FilePath) -> FilePath -> IO ()
produceSound4 (file, file1) fileB = do
norm fileB
volS2 ("8" ++ fileB) file
renameFile ("8." ++ fileB) file1
-- | Function 'showCoef' is used to represent the duration of the sound file.
showCoef :: String -> String
showCoef xs | '.' `elem` xs =
let (ts, us) = break (== '.') xs in let ws = showFFloat (Just 6) ((fromIntegral (read (take 6 . drop 1 $ us)::Int) + 1.0) / 1000000.0) "" in
ts ++ drop 1 ws
| otherwise = xs
-- | Function 'beginProcessing' is used to catch the variant where the sound is fully cut by the SoX because the sound was created in inappropriate time.
-- It returns the process to the beginning of the sound recording. For the meaning of the tuple of @Sring@ parameters, refer to
-- 'produceSound' documentation. The first @FilePath@ in the tuple of @FilePath@ parameters is a name of the sound file in @mmsyn6ukr-array@ package. The second one is the
-- name of the resulting file to be produced in the current directory.
beginProcessing :: (FilePath, FilePath) -> String -> (String, String) -> IO ()
beginProcessing (file, file1) soundUkr (actsctrl, noiseLim) = 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
; putStrLn " *****"
; putStrLn ""
; putStrLn "The sound duration is: "
; produceSound2 (file, file1) (actsctrl, noiseLim) soundUkr}
-- | Function 'produceSound2' is used internally in the 'produceSound' function.
produceSound2 :: (FilePath, FilePath) -> (String, String) -> String -> IO ()
produceSound2 (file, file1) (actsctrl, noiseLim) soundUkr = do {
; duration0 <- durationA file
; putStrLn $ showCoef (showFFloat (Just 6) duration0 "")
; putStrLn ""
; putStrLn "It means that to produce more than 3 seconds of recording, you must specify at least "
; putStrLn $ " " ++ show (3.0/duration0) ++ " as a next step ratio being prompt "
; putStrLn " OR "
; putStrLn $ " " ++ show (1.0/duration0) ++ " per one second but not less than the previous number."
; putStrLn $ "For example for 10 seconds record, please, specify " ++ show (10.0/duration0) ++ " as a next step ratio."
; putStrLn " *****"
; putStrLn ""
; (_, Just hout, _, _) <- createProcess (proc (fromJust . showE $ "soxi") ["-D", file]) { std_out = CreatePipe }
; x3 <- hGetContents hout
; recommendSharp soundUkr
; (longerK0,pause0,sharp) <- tempS soundUkr noiseLim
; let longerK = (read x3::Float)*longerK0
; putStrLn $ "Please, wait for " ++ show pause0 ++ " seconds and pronounce the sound representation for the "
; putStrLn ""
; putStrLn $ " \"" ++ (if soundUkr /= "ь" then map toUpper soundUkr else soundUkr) ++ "\""
; putStrLn ""
; putStrLn " sound or whatever you would like to be substituted instead (be sensible, please)! "
; if sharp || (compare longerK 3.0 == GT)
then recB "x.wav" (longerK, pause0)
else recB "x.wav" (3.0, pause0)
; 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. "
; controlNoiseReduction actsctrl
; norm "_x.wav"
; lim0 <- durationA "8_x.wav"
; if null noiseLim
then putStrLn ""
else if last noiseLim == 's'
then putStr ""
else putStrLn ""
; let noiseMax = case (take 1 noiseLim) of
"0" -> 0::Int
"1" -> 1::Int
"2" -> 2::Int
"3" -> 3::Int
_ -> 2::Int
; produceSound3 (actsctrl, noiseLim) (file, file1) soundUkr (noiseMax, duration0) lim0
; cleanTemp }
-- | Function 'controlNoiseReduction' is used in the 'produceSound2' and 'beginProcessing' functions to reduce the noise with the created by the
-- 'tempeRa' noise profile. If you specified something else than \"-1\" as a first command line argument, then the program will reduce the noise
-- using the created noise profile.
-- If the first character is one of the following, then the program will do the following actions besides. After the first character
-- (without any spaces) you can specify the level of noise reduction by 2 next digits. They are treated by the program as a fractional part
-- of the number \"0.\" ++ \"...\" so that the last number is passed to the SoX as an amount parameter in the \"noisered\" effect
-- (the greater number gives more aggressive noise reduction with the default one equal to 0.5. For more information, please, refer to the SoX documentation.
controlNoiseReduction :: String -> IO ()
controlNoiseReduction actsctrl = if actsctrl /= "-1"
then do
s2 <- onException (do
let s1 = take 1 actsctrl
sr0 = filter isDigit . drop 1 $ actsctrl
if null sr0
then return 0.5
else let sr = "0." ++ sr0
s = read sr::Float in if s > 0.0 then return s else return 0.01) (return 0.5)
(code, _, _) <- readProcessWithExitCode (fromJust (showE "sox")) ["x.wav", "_x.wav", "noisered", "nx0.wav.b.prof", showFFloat (Just 4) s2 $ show 0] ""
if code /= ExitSuccess
then do
e1 <- doesFileExist "_x.wav"
if e1
then do
removeFile "_x.wav"
catchEnd (NotCreatedWithEffect "noisered")
else catchEnd (NotCreatedWithEffect "noisered")
else do
e2 <- doesFileExist "_x.wav"
if e2
then return ()
else catchEnd (InitialFileNotChanged "x.wav")
else renameFile "x.wav" "_x.wav"
-- | Function to get the @(Float, Float, Bool)@ value. The first @Float@ value shows in how many times you expect that your sound representation
-- will be longer than the one provided by the @mmsyn6ukr-array@ package. The second one specifies a duration of the pause before SoX actually starts to
-- record the needed sound data (in seconds). The @Bool@ value specifies whether the program uses a \'sharp\' mode meaning that
-- it does not check whether the resulting duration of the recording is at least 3 seconds long, so you can specify shorter durations.
-- The @String@ arguments are the Ukrainian sound representation name and the second command line argument for the program respectively.
tempS :: String -> String -> IO (Float, Float, Bool)
tempS soundUkr noiseLim = onException (do
if null noiseLim
then putStrLn ""
else if last noiseLim == 's'
then putStr ""
else putStrLn ""
putStrLn "In how many times do you think your sound representing "
putStrLn ""
putStrLn $ " \"" ++ (if soundUkr /= "ь" then map toUpper soundUkr else soundUkr) ++ "\""
putStrLn ""
putStrLn "will sound longer than the recently played one? Specify your input as a Float value without \'e\' notation (with the preceding asterisk sign for the \'sharp\' mode). "
putStrLn ""
longivityZ <- getLine
let sharp0 = take 1 longivityZ
sharp1 = drop 1 . dropWhile (/= '#') $ longivityZ
sharp2 = if null sharp1 then 0.5 else let zzz0 = read (filter (\z -> isDigit z || z == '.') sharp1)::Float in if zzz0 /= 0.0 then zzz0 else 0.5
case sharp0 of
"*" -> let long = read (takeWhile (/= '#') . drop 1 $ longivityZ)::Float in return (long,sharp2,True)
_ -> let long = read (takeWhile (/= '#') longivityZ)::Float in return (long,sharp2,False)) (do
putStrLn "Please, specify again the valid values!"
tempS soundUkr noiseLim)
-- | Function 'cleanTemp' removes all the intermediate temporary files in the directory where it is called from.
cleanTemp :: IO ()
cleanTemp = do
filenames <- getDirectoryContents =<< getCurrentDirectory
mapM_ removeFile . filter (\x -> head x `elem` (['2'..'9'] ++ "_" ++ "x")) $ filenames
-- | Function 'cleanTempN' removes all the intermediate temporary files produced during a noise profile creation in the directory where it is called from.
cleanTempN :: IO ()
cleanTempN = do
filenames <- getDirectoryContents =<< getCurrentDirectory
mapM_ removeFile . filter (\x -> head x == 'n') $ filenames
-- | Function 'tempeRa' is used to create a noise profile for all the recorded sounds. The function is used internally in the @mmsyn7ukr@
-- program. While running if you provide a 5 seconds silence as needed, the program @mmsyn7ukr@ will
-- reduce the noise in your recordings. This will create a cleaner sound. If you would like not to reduce the noise at all, then, please,
-- specify \"-1\" as the first command line argument for the program @mmsyn7ukr@.
tempeRa :: Int -> IO ()
tempeRa n = do {
putStrLn "Now, please, be in a silence for 5 seconds so that the program can create a noise profile to remove the noise from the recording. "
; putStr "Otherwise, the program can remove from the recorded sound data some important parts as a noise. "
; if n == 1 then putStrLn "If you would like not to reduce the noise at all, then, please, specify as the first command line argument \"-1\". "
else putStr ""
; CM.zipWithM_ (\i x -> recA ("nx" ++ show i ++ ".wav") 0.07 >> threadDelay (50000 * x)) [1..5] $ [2,3,2,2,3]
; [upperB1,upperB2,upperB3,upperB4,upperB5] <- mapM (\c -> upperBnd ("nx" ++ (c:".wav"))) "12345"
; v0 <- CM.zipWithM (\i upp -> fmap (\kt -> abs (read (fst kt)::Float)) . selMaxAbs ("nx" ++ show i ++ ".wav") $ (0,upp)) [1..5] $ [upperB1,upperB2,upperB3,upperB4,upperB5]
; let minn = minimum v0 in renameFile ("nx" ++ (show ((fromJust . L.findIndex (<= minn) $ v0) + 1) ++ ".wav")) "nx0.wav"
; noiseProfB "nx0.wav" >> putStrLn "" >> threadDelay 400000 >> putStrLn "The noise sound profile is now created. The program can proceed further." }
-- | Function 'recommendSharp' is used to print an advice about the speech transformation for the Ukrainian sounds that you can pronounce
-- properly continually and so it can be better to use for their producing a \'sharp\' mode.
recommendSharp :: String -> IO ()
recommendSharp soundUkr = do
let k0 = getBFst' (False, listArray (0,16) . zip ["\1072","\1077","\1078","\1079","\1080","\1083","\1084","\1085","\1086","\1088","\1089","\1089\1100","\1091","\1092","\1093","\1096","\1110"] $ replicate 17 True) soundUkr
if k0
then do
putStr $ "In case of speech transformation: for the sound representation for the Ukrainian \"" ++ soundUkr
putStrLn "\" it is recommended to use a \'sharp\' mode. So, try to specify \'*\' as a first symbol and maybe pronounce the corresponding Ukrainian sound continually. "
else do
putStr $ "In case of speech transformation: for the sound representation for the Ukrainian \"" ++ soundUkr
putStrLn "\" it is recommended to use a common mode (the usual one). So, try not to specify \'*\' as a first symbol. "