-- | -- Module : DobutokO.Sound -- 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. module DobutokO.Sound ( -- * Basic functions for the executable dobutokO2 , recAndProcess -- * Library and executable functions -- ** For the fixed timbre , oberTones , oberSoXSynth , oberSoXSynthN , oberSoXSynthNGen -- ** For the unique for the String structure timbre , uniqOberTonesV , uniqOberSoXSynth , uniqOberSoXSynthN , uniqOberSoXSynthNGen -- ** Work with octaves , octavesT , octaveUp , octaveDown , whichOctave , putInOctave , putInOctaveV -- ** Auxiliary functions , notes , neighbourNotes , closestNote , pureQuintNote , syllableStr , prependZeroes ) where import Control.Exception (onException) import System.Environment (getArgs) import Data.List (isPrefixOf,sort) import Data.Maybe (isJust,fromJust) import Data.Char (isDigit) import qualified Data.Vector as V import System.Process import EndOfExe import MMSyn7.Syllable import MMSyn7s import System.Directory import SoXBasics import Processing_mmsyn7ukr -- | 'V.Vector' of musical notes in Hz. notes :: V.Vector Double -- notes V.! 57 = 440.0 -- A4 in Hz notes = V.generate 108 (\t -> fromIntegral 440 * 2 ** (fromIntegral (t - 57) / fromIntegral 12)) -- | Function returns either the nearest two musical notes if frequency is higher than one for C0 and lower than one for B8 or the nearest note duplicated in a tuple. neighbourNotes :: Double -> V.Vector Double -> (Double, Double) neighbourNotes x v | compare x (V.unsafeIndex v 0) /= GT = (V.unsafeIndex v 0, V.unsafeIndex v 0) | compare x (V.unsafeIndex v (V.length v - 1)) /= LT = (V.unsafeIndex v (V.length v - 1), V.unsafeIndex v (V.length v - 1)) | compare (V.length v) 2 == GT = if compare x (V.unsafeIndex v (V.length v `quot` 2)) /= GT then neighbourNotes x (V.unsafeSlice 0 (V.length v `quot` 2 + 1) v) else neighbourNotes x (V.unsafeSlice (V.length v `quot` 2) (V.length v - (V.length v `quot` 2)) v) | otherwise = (V.unsafeIndex v 0, V.unsafeIndex v (V.length v - 1)) -- | Returns the closest note to the given frequency in Hz. closestNote :: Double -> Double closestNote x | compare x 0.0 == GT = let (x0, x2) = neighbourNotes x notes r0 = x / x0 r2 = x2 / x in if compare r2 r0 == GT then x0 else x2 | otherwise = 0.0 -- | Returns a pure quint lower than the given note. pureQuintNote :: Double -> Double pureQuintNote x = x / 2 ** (fromIntegral 7 / fromIntegral 12) -- | Returns an analogous note in the higher octave (its frequency in Hz). octaveUp :: Double -> Double octaveUp x = 2 * x -- | Returns an analogous note in the lower octave (its frequency in Hz). octaveDown :: Double -> Double octaveDown x = x / fromIntegral 2 -- | Returns a 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the octaves. octavesT :: V.Vector (Double, Double) octavesT = V.generate 9 (\i -> (V.unsafeIndex notes (i * 12), V.unsafeIndex notes (i * 12 + 11))) -- | Function can be used to determine to which octave (in the American notation for the notes, this is a number in the note written form, -- e. g. for C4 this is 4) the frequency belongs (to be more exact, the closest note for the given frequency -- see 'closestNote' taking into account -- its lower pure quint, which can lay in the lower by 1 octave). If it is not practical to determine the number, then the function returns 'Nothing'. whichOctave :: Double -> Maybe Int whichOctave x | compare (closestNote x) 24.4996 == GT = (\t -> case isJust t of True -> fmap (\z -> case z of 0 -> z _ -> z - 1) t _ -> Just 8) . V.findIndex (\(t1, t2) -> compare (closestNote x) t1 == LT) $ octavesT | otherwise = Nothing -- | Function lifts the given frequency to the given number of the octave (in American notation, from 0 to 8). This number is an 'Int' parameter. -- The function also takes into account the lower pure quint for the closest note. -- If it is not practical to determine the number, then the function returns 'Nothing'. putInOctave :: Int -> Double -> Maybe Double putInOctave n x | compare n 0 == LT || compare n 8 == GT = Nothing | compare (closestNote x) 24.4996 == GT = case compare (fromJust . whichOctave $ x) n of EQ -> Just (closestNote x) LT -> let z = log (V.unsafeIndex notes (n * 12) / closestNote x) / log 2.0 z1 = truncate z in if abs (z - fromIntegral z1) > 0.999 || abs (z - fromIntegral z1) < 0.001 then Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 1) octaveUp $ closestNote x) else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 2) octaveUp $ closestNote x) _ -> let z = log (closestNote x / V.unsafeIndex notes (n * 12)) / log 2.0 z1 = truncate z in if abs (z - fromIntegral z1) > 0.999 || abs (z - fromIntegral z1) < 0.001 then Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 2) octaveDown $ closestNote x) else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 1) octaveDown $ closestNote x) | otherwise = Nothing -- | Function lifts the 'V.Vector' of 'Double' representing frequencies to the given octave with the 'Int' number. Better to use numbers in the range [1..8]. -- The function also takes into account the lower pure quint for the obtained note behaviour. If it is not practical to determine the octave, the resulting -- frequency is omitted from the resulting 'V.Vector'. putInOctaveV :: Int -> V.Vector Double -> V.Vector Double putInOctaveV n = V.mapMaybe (\z -> putInOctave n z) -- | Function is used to generate a rhythm of the resulting file \'end.wav\' from the Ukrainian text and a number of sounds either in the syllables or in the words without vowels. syllableStr :: Int -> String -> [Int] syllableStr n xs = let ps = take n . cycle . concat . sylLengthsP2 . syllablesUkrP $ xs y = sum ps in case y of 0 -> [0] _ -> y:ps -- | For the given frequency of the note it generates a 'V.Vector' of the tuples, each one of which contains the harmonics' frequency and amplitude. oberTones :: Double -> V.Vector (Double, Double) oberTones note = V.takeWhile (\w -> compare (fst w) (V.unsafeIndex notes 107) /= GT && compare (snd w) 0.001 == GT) . V.zip (V.generate 1024 (\i -> note * fromIntegral (i + 2))) $ (V.generate 1024 (\i -> fromIntegral 1 / fromIntegral ((i + 1) * (i + 1)))) -- | For the given frequency of the note it generates a 'V.Vector' of the tuples, each one of which contains the harmonics' frequency and amplitude. For every given -- 'String' structure of the uniqueness (see the documentation for @mmsyn7s@ package and its 'MMSyn7.Syllable' module) it produces the unique timbre. uniqOberTonesV :: Double -> String -> V.Vector (Double, Double) uniqOberTonesV note xs = let ys = uniquenessPeriods xs z = sum ys v = V.fromList . fmap (\y -> fromIntegral y / fromIntegral z) $ ys z2 = V.length v v2 = V.generate z2 $ (\i -> V.unsafeIndex v i / fromIntegral (i + 1)) in V.takeWhile (\u -> compare (fst u) (V.unsafeIndex notes 107) /= GT && compare (snd u) 0.001 == GT) . V.unsafeSlice 1 (z2 - 1) . V.zip (V.generate z2 (\i -> note * fromIntegral (i + 1))) $ v2 -- | For the given frequency it generates a musical sound with a timbre. The main component of the sound includes the lower pure quint, -- which can be in the same octave or in the one with the number lower by one. oberSoXSynth :: Double -> IO () oberSoXSynth x = do let note0 = closestNote x note1 = pureQuintNote note0 v0 = oberTones note0 v1 = oberTones note1 oberSoXSynthHelp vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", show noteN, "vol", show amplN] "") vec oberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", show noteN, "vol", show amplN] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", show note0, "synth", "0.5","sine", "mix", show note1] "" 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 -- | Function to create a melody for the given arguments. 'String' is used to provide a rhythm. The main component of the sound includes the lower pure quint, which -- can be in the same octave or in the one with the number lower by one. oberSoXSynthN :: Int -> String -> V.Vector Double -> IO () oberSoXSynthN n zs vec0 = V.imapM_ (\j x -> do let note0 = closestNote x -- zs is obtained from the command line arguments note1 = pureQuintNote note0 v0 = oberTones note0 v1 = oberTones note1 (t, ws) = splitAt 1 . syllableStr n $ zs zeroN = numVZeroesPre vec0 v2 = V.map (\yy -> 0.5 * fromIntegral (yy * n) / fromIntegral (head t)) . V.fromList $ ws oberSoXSynthHelpN vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec oberSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN "1" ++ ".wav", "synth", "0.5","sine", show note0, "synth" , "0.5","sine", "mix", show note1] "" oberSoXSynthHelpN v0 oberSoXSynthHelpN2 v1 paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) "" mapM_ removeFile paths ) vec0 -- | Similar to 'oberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one. Besides, the function lifts -- the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). oberSoXSynthNGen :: FilePath -> Int -> String -> IO () oberSoXSynthNGen file m zs = do duration0 <- durationA file let n = truncate (duration0 / 0.001) vecA <- V.generateM n (\k -> do { (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", show (fromIntegral k * 0.001), "0.001", "stat"] "" ; let line0s = lines herr noteN1 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s ; if null noteN1 then return (11440::Int) else let noteN2 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 }) let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA oberSoXSynthN n zs vecB path2s <- listDirectory "." let paths3 = sort . filter (isPrefixOf "result") $ path2s _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" mapM_ removeFile paths3 -- | Additional function to prepend zeroes to the given 'String'. The number of them are just that one to fulfill the length to the given 'Int' parameter. prependZeroes :: Int -> String -> String prependZeroes n xs | if compare n 0 /= GT || null xs then True else compare n (length xs) /= GT = xs | otherwise = replicate (n - length xs) '0' ++ xs nOfZeroesLog :: Int -> Maybe Int nOfZeroesLog x | compare x 0 /= GT = Nothing | otherwise = Just (truncate (log (fromIntegral x) / log 10) + 1) numVZeroesPre :: V.Vector a -> Int numVZeroesPre v = let xx = nOfZeroesLog . V.length $ v in if isJust xx then fromJust xx else 0::Int -- | For the given frequency and a Ukrainian text it generates a musical sound with the timbre obtained from the Ukrainian text (see the documentation for @mmsyn7s@ -- package). The timbre for another given text usually differs, but can be the same. The last one is only if the uniqueness structure and length are the -- same for both 'String'. Otherwise, they differs. This gives an opportunity to practically and quickly synthesize differently sounding intervals. -- The main component of the sound includes the lower pure quint, which can be in the same octave or in the one with -- the number lower by one. uniqOberSoXSynth :: Double -> String -> IO () uniqOberSoXSynth x wws = do let note0 = closestNote x note1 = pureQuintNote note0 v0 = uniqOberTonesV note0 wws v1 = uniqOberTonesV note1 wws uniqOberSoXSynthHelp vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", show noteN, "vol", show amplN] "") vec uniqOberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", show noteN, "vol", show amplN] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test-.wav", "synth", "0.5","sine", show note0, "synth", "0.5","sine", "mix", show note1] "" uniqOberSoXSynthHelp v0 uniqOberSoXSynthHelp2 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 -- | Function to create a melody for the given arguments. The first 'String' is used to provide a rhythm. The second one -- to provide a timbre. -- The timbre for another given text usually differs, but can be the same. This gives an opportunity to practically and quickly -- synthesize differently sounding intervals. -- The main component of the sound is in the given octave with a number given -- by 'Int' parameter. Besides, another main component of the sound includes the lower pure quint, which can be in the same octave or in the one with -- the number lower by one. uniqOberSoXSynthN :: Int -> String -> String -> V.Vector Double -> IO () uniqOberSoXSynthN n zs wws vec0 = V.imapM_ (\j x -> do let note0 = closestNote x -- zs ? vec0 -- are they related to the one object? No, they are obtained from different sources. note1 = pureQuintNote note0 v0 = uniqOberTonesV note0 wws v1 = uniqOberTonesV note1 wws (t, ws) = splitAt 1 . syllableStr n $ zs zeroN = numVZeroesPre vec0 v2 = V.map (\yy -> 0.5 * fromIntegral (yy * n) / fromIntegral (head t)) . V.fromList $ ws uniqOberSoXSynthHelpN vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec uniqOberSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN "1" ++ ".wav", "synth", "0.5","sine", show note0, "synth", "0.5","sine", "mix", show note1] "" uniqOberSoXSynthHelpN v0 uniqOberSoXSynthHelpN2 v1 paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) "" mapM_ removeFile paths ) vec0 -- | Similar to 'uniqOberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one. -- Besides, the function lifts the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). uniqOberSoXSynthNGen :: FilePath -> Int -> String -> String -> IO () uniqOberSoXSynthNGen file m 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", show (fromIntegral k * 0.001), "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 = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA uniqOberSoXSynthN n zs wws vecB path2s <- listDirectory "." let paths3 = sort . filter (isPrefixOf "result") $ path2s _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" mapM_ removeFile paths3 -- | Function that actually makes processing in the @dobutokO2@ executable. dobutokO2 :: IO () dobutokO2 = do args <- getArgs let arg1 = concat . take 1 $ args file = concat . drop 1 . take 2 $ args case arg1 of "1" -> do [_,_,octave] <- mapM (recAndProcess file) [1..3] let octave1 = read octave::Int oberSoXSynthNGen (file ++ ".wav") octave1 (unwords . drop 2 $ args) _ -> do [_,_,octave,wws] <- mapM (recAndProcess file) [1..4] let octave1 = read octave::Int uniqOberSoXSynthNGen (file ++ ".wav") octave1 (unwords . drop 2 $ args) wws -- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. recAndProcess :: String -> Int -> IO String recAndProcess file x | 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 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" ctrlN <- getLine let noiseP = tail . dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN controlNoiseReduction $ '0':noiseP norm "_x.wav" if isPrefixOf "nx." file then putStr "" else renameFile "8_x.wav" (file ++ ".wav") 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) `mod` 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) | 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 4)