-- | -- Module : DobutokO.Sound.Executable -- 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. {-# OPTIONS_GHC -threaded #-} module DobutokO.Sound.Executable ( -- * Basic functions for the executable dobutokO2 , recAndProcess ) where import Numeric import Control.Exception (onException) import System.Environment (getArgs) import Data.List (isPrefixOf,sort,sortBy) import Data.Maybe (isJust,isNothing,fromJust) import Data.Char (isDigit) import System.Process import EndOfExe -- import MMSyn7.Syllable -- import MMSyn7s import System.Directory import SoXBasics import Processing_mmsyn7ukr import Melodics.Ukrainian import DobutokO.Sound hiding (dobutokO2, recAndProcess) -- import DobutokO.Sound.Functional -- | 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. dobutokO2 :: IO () dobutokO2 = do args <- getArgs let arg1 = concat . take 1 $ args file = concat . drop 1 . take 2 $ args exist2 <- doesFileExist file case arg1 of "1" -> 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 oberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args) "2" -> 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 uniqOberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args) wws "3" -> 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 oberSoXSynthNGen2 file octave1 ampL time3 (unwords . drop 2 $ args) tts "4" -> 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 uniqOberSoXSynthNGen3 file octave1 ampL time3 (unwords . drop 2 $ args) wws tts "5" -> 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 oberSoXSynthNGen3 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) tts vs _ -> 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 uniqOberSoXSynthNGen4 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) wws tts vs -- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing -- whether there is no \"x.wav\" file in the current directory, because it can be overwritten. recAndProcess :: String -> Int -> IO String recAndProcess file x | x == 0 = onException (readProcessWithExitCode (fromJust (showE "sox")) [file, "x.wav", "-r22050", "channels", "1"] "" >> putStrLn "" >> return "") (do exist <- doesFileExist "x.wav" if exist then removeFile "x.wav" else putStr "" putStrLn "" putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. " putStrLn "Interrupt the program and start again with the valid file. " putStrLn "_______________________________________________________________________" recAndProcess file 0) | x == 1 = onException (do tempeRa 0 putStrLn "Please, specify, how many seconds long sound data you would like to record." time <- getLine let time0 = read (filter (\t -> isDigit t || t == '.') $ time)::Double putStrLn "Please, wait for 0.5 second and produce the needed sound now." recA "x.wav" time0 putStrLn "" return "") (do dir0 <- listDirectory "." let paths5 = filter (isPrefixOf "nx.") dir0 mapM_ removeFile paths5 putStrLn "" putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 1) | x == 2 = onException (do exist3 <- doesFileExist file if exist3 then return "" else do putStr "Please, specify the control parameter for the SoX \"noisered\" effect in the range from 0.0 to 1.0. " putStrLn "The greater value causes more reduction with possibly removing some important sound data. The default value is 0.5 " putStrLn "To use the default value, you can simply press Enter." ctrlN <- getLine let addit = dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN noiseP = if null ctrlN then "" else tail addit controlNoiseReduction $ '0':noiseP norm "_x.wav" if isPrefixOf "nx." file then putStr "" else renameFile "8_x.wav" file removeFile "x.wav" removeFile "_x.wav" dir <- listDirectory "." let paths4 = filter (isPrefixOf "nx.") dir mapM_ removeFile paths4 putStrLn "" return "") (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 2) | x == 3 = onException (do putStr "Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) " putStrLn "should belong. The number should be better in the range [1..8]" octave0 <- getChar let octave = (read [octave0]::Int) `rem` 9 return $ show octave ) (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 3) | x == 4 = onException (do putStr "Please, specify the amplitude for the generated obertones as an Int number in the range [0..99]. " putStrLn "The default one is 99" putStrLn "To use the default value, you can simply press Enter." amplOb0 <- getLine if null amplOb0 then return "1.0" else let amplOb = (read (take 2 . filter isDigit $ amplOb0)::Int) `rem` 100 in case amplOb of 99 -> return "1.0" _ -> if compare (amplOb `quot` 9) 1 == LT then return $ "0.0" ++ show (amplOb + 1) else return $ "0." ++ show (amplOb + 1)) (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 4) | x == 5 = onException (do putStr "Please, specify the basic duration for the generated sounds as a Double number in the range [0.1..4.0]. " putStrLn "The default one is 0.5" putStrLn "To use the default value, you can simply press Enter." time0 <- getLine if null time0 then return "0.5" else let time1 = (read (filter (\z -> isDigit z || z == '.') $ time0)::Double) in if compare time1 0.1 /= LT && compare time1 4.0 /= GT then return (showFFloat (Just 4) time1 $ show 0) else let mantissa = time1 - (fromIntegral . truncate $ time1) ceilP = (truncate time1::Int) `rem` 4 in if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0)) else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 5) | x == 7 = onException (do putStrLn "Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: " tts <- getLine if null tts then return "або" else return tts) (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 7) | x == 8 = onException (do putStr "Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. " putStrLn "The number is in the range [0.1..2.0]. The default one is 1.0" putStrLn "To use the default value, you can simply press Enter." dAmpl0 <- getLine if null dAmpl0 then return "1.0" else let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') $ dAmpl0)::Double) in if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then return (showFFloat (Just 4) dAmpl1 $ show 0) else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1) ceilP = (truncate dAmpl1::Int) `rem` 2 in if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0)) else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 8) | x == 9 = onException (do putStrLn "Please, input the Ukrainian text that will be used to define intervals to be used to produce the lower note for the given main one. " putStrLn "The default one is \"й\". " putStrLn "To use the default value, you can simply press Enter." vs <- getLine if null vs then return "й" else return vs) (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 9) | otherwise = onException (do putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: " wws <- getLine return wws) (do putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." putStrLn "_______________________________________________________________________" recAndProcess file 100)