-- | -- Module : DobutokO.Sound -- Copyright : (c) OleksandrZhabenko 2020 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- Helps to create experimental music from a file (or its part) and a Ukrainian text. -- It can also generate a timbre for the notes. Uses SoX inside. {-# LANGUAGE BangPatterns, LambdaCase #-} {-# OPTIONS_GHC -threaded #-} module DobutokO.Sound ( -- * Library and executable functions -- ** For the fixed timbre overSoXSynthN -- *** For the fixed timbre with different signs for harmonics coefficients , overTones2 , overSoXSynth2 , overSoXSynthN2 , overSoXSynthN3 -- *** Use additional parameters , overSoXSynthDN , overSoXSynth2DN -- *** Use a file for information , overSoXSynthNGen , overSoXSynthNGen2 , overSoXSynthNGen3 -- ** For the unique for the String structure timbre , uniqOvertonesV , uniqOverSoXSynth , uniqOverSoXSynthN -- *** For the unique for the String structure timbre with different signs for harmonics coefficients , uniqOvertonesV2 , uniqOverSoXSynth2 , uniqOverSoXSynthN3 , uniqOverSoXSynthN4 -- *** Use a file for information , uniqOverSoXSynthNGen , uniqOverSoXSynthNGen3 , uniqOverSoXSynthNGen4 -- ** Work with octaves , octaveUp , octaveDown , liftInOctave , liftInOctaveV -- ** Even more extended , dviykyTA , triykyTA , chetvirkyTA , p'yatirkyTA , shistkyTA , simkyTA , visimkyTA , dev'yatkyTA , desyatkyTA , odynadtsyatkyTA , octavesTA -- * Extended generation using enky functionality -- ** With somewhat fixed timbre , overSoXSynthNGenE , overSoXSynthNGen2E , overSoXSynthNGen3E -- ** With usage of additional information in the Ukrainian text , uniqOverSoXSynthNGenE , uniqOverSoXSynthNGen3E , uniqOverSoXSynthNGen4E -- * Auxiliary functions , signsFromString -- * New 4G functions to work with Durations , overSoXSynthN4G , overSoXSynthN24G , overSoXSynthN34G , overSoXSynthNGenE4G , overSoXSynthNGen2E4G , overSoXSynthNGen3E4G , uniqOverSoXSynthN4G , uniqOverSoXSynthN34G , uniqOverSoXSynthN44G , uniqOverSoXSynthNGenE4G , uniqOverSoXSynthNGen3E4G , uniqOverSoXSynthNGen4E4G -- ** 4G with speech-like composition , overSoXSynthN4GS , overSoXSynthN24GS , overSoXSynthN34GS , overSoXSynthNGenE4GS , overSoXSynthNGen2E4GS , overSoXSynthNGen3E4GS , uniqOverSoXSynthN4GS , uniqOverSoXSynthN34GS , uniqOverSoXSynthN44GS , uniqOverSoXSynthNGenE4GS , uniqOverSoXSynthNGen3E4GS , uniqOverSoXSynthNGen4E4GS -- * New 5G functions to work also with Intervals , overSoXSynthN35G , overSoXSynthNGen3E5G , uniqOverSoXSynthN45G , uniqOverSoXSynthNGen4E5G -- ** 5G with obtained from the text arbitraty length Intervals , overSoXSynthN35GS , overSoXSynthNGen3E5GS , uniqOverSoXSynthN45GS , uniqOverSoXSynthNGen4E5GS -- * New 6G function to work also with Strengths , overSoXSynthNGen3E6G , uniqOverSoXSynthNGen4E6G -- ** 6G with obtained from the text arbitrary length Strengths , overSoXSynthNGen3E6GS , overSoXSynthNGen3E6GSu , uniqOverSoXSynthN46GSu , uniqOverSoXSynthNGen4E6GS , uniqOverSoXSynthNGen4E6GSu -- * New generalized functions working with Params , overSoXSynthNGenEPar , overSoXSynthNGenE4GSPar , overSoXSynthNGenE4GPar , overSoXSynthNGen2EPar , overSoXSynthNGen2E4GSPar , overSoXSynthNGen2E4GPar , overSoXSynthNGen3EPar , overSoXSynthNGen3E4GSPar , overSoXSynthNGen3E4GPar , overSoXSynthNGen3E5GPar , overSoXSynthNGen3E5GSPar , overSoXSynthNGen3E6GPar , overSoXSynthNGen3E6GSPar , overSoXSynthNGen3E6GSuPar -- ** With overtones obtained from the additional Ukrainian text , uniqOverSoXSynthNGenEPar , uniqOverSoXSynthNGenE4GSPar , uniqOverSoXSynthNGenE4GPar , uniqOverSoXSynthNGen3EPar , uniqOverSoXSynthNGen3E4GSPar , uniqOverSoXSynthNGen3E4GPar , uniqOverSoXSynthNGen4EPar , uniqOverSoXSynthNGen4E4GSPar , uniqOverSoXSynthNGen4E4GPar , uniqOverSoXSynthNGen4E5GPar , uniqOverSoXSynthNGen4E5GSPar , uniqOverSoXSynthNGen4E6GPar , uniqOverSoXSynthNGen4E6GSPar , uniqOverSoXSynthNGen4E6GSuPar ) where import CaseBi (getBFst') import System.Exit (ExitCode(ExitSuccess)) import Numeric (showFFloat) import Control.Exception (onException) import System.Environment (getArgs) import Data.List (isPrefixOf,sort,sortBy,nubBy) import Data.Maybe (isJust,isNothing,fromJust,maybe) import Data.Char (isDigit) import qualified Data.Vector as V import System.Process import EndOfExe (showE) import MMSyn7.Syllable import MMSyn7s import System.Directory import SoXBasics import Processing_mmsyn7ukr import Melodics.Ukrainian (convertToProperUkrainian) import DobutokO.Sound.Functional dviykyTA :: NotePairs dviykyTA = V.generate 107 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 1))) triykyTA :: NotePairs triykyTA = V.generate 106 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 2))) chetvirkyTA :: NotePairs chetvirkyTA = V.generate 105 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 3))) p'yatirkyTA :: NotePairs p'yatirkyTA = V.generate 104 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 4))) shistkyTA :: NotePairs shistkyTA = V.generate 103 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 5))) simkyTA :: NotePairs simkyTA = V.generate 102 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 6))) visimkyTA :: NotePairs visimkyTA = V.generate 101 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 7))) dev'yatkyTA :: NotePairs dev'yatkyTA = V.generate 100 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 8))) desyatkyTA :: NotePairs desyatkyTA = V.generate 99 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 9))) odynadtsyatkyTA :: NotePairs odynadtsyatkyTA = V.generate 98 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 10))) octavesTA :: NotePairs octavesTA = V.generate 97 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 11))) -------------------------------------------------------------------------------------------------------------------------- -- | Returns an analogous note in the higher octave (its frequency in Hz). octaveUp :: Double -> Double octaveUp x = 2 * x {-# INLINE octaveUp #-} -- | Returns an analogous note in the lower octave (its frequency in Hz). octaveDown :: Double -> Double octaveDown x = x / 2 {-# INLINE octaveDown #-} ----------------------------------------------------------------------------------------------------------------------------- -- | 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'. liftInOctave :: Int -> Double -> Maybe Double liftInOctave 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 = logBase 2.0 (V.unsafeIndex notes (n * 12) / closestNote x) 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 = logBase 2.0 (closestNote x / V.unsafeIndex notes (n * 12)) 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'. liftInOctaveV :: Int -> V.Vector Double -> V.Vector Double liftInOctaveV n = V.mapMaybe (liftInOctave n) -------------------------------------------------------------------------------------------------------------------------------- -- | 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. uniqOvertonesV :: Double -> String -> OvertonesO uniqOvertonesV 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,!z) -> compare u (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.unsafeSlice 1 (z2 - 1) . V.zip (V.generate z2 (\i -> note * fromIntegral (i + 1))) $ v2 -- | Additional function to produce signs from the given 'String' of the Ukrainian text. Ukrainian vowels and voiced consonants gives \"+\" sign (+1), voiceless -- and sonorous consonants gives \"-\" sign (-1). Voiceless2 gives "0". Other symbols are not taken into account. signsFromString :: Int -> String -> V.Vector Int signsFromString n1 = V.take n1 . V.fromList . concatMap (fmap (\case Vowel _ -> 1 Voiced _ -> 1 VoicedP _ -> 1 Voiceless _ -> (-1) VoicelessP _ -> (-1) Sonorous _ -> (-1) SonorousP _ -> (-1) _ -> 0) . concatMap representProlonged) . syllablesUkrP . take (3 * n1) . cycle -- | For the given frequency of the note and a Ukrainian text it generates a 'V.Vector' of the tuples, each one of which contains -- the harmonics' frequency and amplitude. The 'String' is used to produce the signs for harmonics coefficients. overTones2 :: Double -> String -> OvertonesO overTones2 note ts = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.filter (\(_, t4) -> t4 /= 0.0) . V.zip (V.generate 1024 (\i -> note * fromIntegral (i + 2))) $ (V.generate 1024 (\i -> fromIntegral (V.unsafeIndex (signsFromString 1024 ts) (i + 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 -- first 'String' argument structure of the uniqueness (see the documentation for @mmsyn7s@ package and its 'MMSyn7.Syllable' module) it produces the unique timbre. -- The second 'String' is used to produce the signs for harmonics coefficients. uniqOvertonesV2 :: Double -> String -> String -> OvertonesO uniqOvertonesV2 note xs ts = 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.map fromIntegral . signsFromString z2 $ ts) i) * V.unsafeIndex v i / fromIntegral (i + 1)) in V.takeWhile (\(!u,!z) -> compare u (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.filter (\(_, t4) -> t4 /= 0.0) . V.unsafeSlice 1 (z2 - 1) . V.zip (V.generate z2 (\i -> note * fromIntegral (i + 1))) $ v2 -- | Similar to 'overSoXSynth' except that takes not necessarily pure lower quint note as the second one, but the one specified by the 'String' parameter -- as an argument to 'dNote'. If you begin the 'String' with space characters, or \"сь\", or \"ць\", or dash, or apostrophe, or soft sign, than there will -- be no interval and the sound will be solely one with its 'OvertonesO'. overSoXSynthDN :: Double -> String -> IO () overSoXSynthDN x = overSoXSynth2DN x 0.5 -- | Similar to 'overSoXSynthDN' except that the resulting duration is specified by the second 'Double' parameter in seconds. For 'overSoXSynthDN' -- it is equal to 0.5. overSoXSynth2DN :: Double -> Double -> String -> IO () overSoXSynth2DN x y zs | V.null . convertToProperUkrainian $ zs = overSoXSynth x | otherwise = do let note0 = closestNote x note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0 v0 = overTones note0 v1 = maybe V.empty overTones note1 overSoXSynthHelp vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y "","sine", showFFloat (Just 4) noteN "", "vol", showFFloat (Just 4) amplN ""] "") vec overSoXSynthHelp2 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y "","sine", showFFloat (Just 4) noteN "", "vol", showFFloat (Just 4) amplN ""] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y "","sine", showFFloat (Just 4) note0 "", "vol","0.5"] "" if isNothing note1 then overSoXSynthHelp v0 else do _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y "","sine", showFFloat (Just 4) (fromJust note1) "", "vol","0.5"] "" overSoXSynthHelp v0 overSoXSynthHelp2 v1 mixTest -- | 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. Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. -- The 'String' argument is used to define signs of the harmonics coefficients for Overtones. overSoXSynth2 :: Double -> String -> IO () overSoXSynth2 x tts = do let note0 = closestNote x note1 = pureQuintNote note0 v0 = overTones2 note0 tts v1 = overTones2 note1 tts overSoXSynthHelp vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN "", "vol", showFFloat (Just 4) amplN ""] "") vec overSoXSynthHelp2 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN "", "vol", showFFloat (Just 4) amplN ""] "") vec _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 "", "synth", "0.5","sine", "mix", showFFloat (Just 4) note1 "", "vol","0.5"] "" overSoXSynthHelp v0 overSoXSynthHelp2 v1 mixTest -- | 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. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude -- for Overtones. If it is set to 1.0 the overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results -- in their becoming more silent ones. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. overSoXSynthN :: Int -> Double -> Double -> String -> V.Vector Double -> IO () overSoXSynthN n ampL time3 zs = overSoXSynthN4G n ampL (str2DurationsDef n zs time3) -- | Function to create a melody for the given arguments. 'Durations' is used to provide a rhythm. overSoXSynthN4G :: Int -> Double -> Durations -> V.Vector Double -> IO () overSoXSynthN4G n ampL v2 vec0 | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let zeroN = numVZeroesPre vec0 v21 = V.filter (/=0.0) v2 m = V.length v2 in V.imapM_ (\j x -> do let note0 = closestNote x -- zs is obtained from the command line arguments note1 = pureQuintNote note0 v0 = overTones note0 v1 = overTones note1 overSoXSynthHelpN vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec overSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", "mix", showFFloat (Just 4) note02 "", "vol",if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain note0 note1 overSoXSynthHelpN v0 overSoXSynthHelpN2 v1 mixTest2 zeroN j) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then overSoXSynthN4G n 0.01 v2 vec0 else overSoXSynthN4G n ampL1 v2 vec0 -- | Variant of the 'overSoXSynthN4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. overSoXSynthN4GS :: Int -> Double -> Double -> String -> V.Vector Double -> IO () overSoXSynthN4GS n ampL time3 zs = overSoXSynthN4G n ampL (str2Durations zs time3) -- | 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. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude -- for Overtones. If it is set to 1.0 the overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results -- in their becoming more silent ones. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. overSoXSynthN2 :: Int -> Double -> Double -> String -> String -> V.Vector Double -> IO () overSoXSynthN2 n ampL time3 zs = overSoXSynthN24G n ampL (str2DurationsDef n zs time3) -- | Function to create a melody for the given arguments. 'Durations' is used to provide a rhythm. overSoXSynthN24G :: Int -> Double -> Durations -> String -> V.Vector Double -> IO () overSoXSynthN24G n ampL v2 tts vec0 | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let v21 = V.filter (/= 0.0) v2 zeroN = numVZeroesPre vec0 m = V.length v21 in V.imapM_ (\j x -> do let note0 = closestNote x -- zs is obtained from the command line arguments note1 = pureQuintNote note0 v0 = overTones2 note0 tts v1 = overTones2 note1 tts overSoXSynthHelpN vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine",showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec overSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", "mix", showFFloat (Just 4) note02 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain note0 note1 overSoXSynthHelpN v0 overSoXSynthHelpN2 v1 mixTest2 zeroN j) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then overSoXSynthN24G n 0.01 v2 tts vec0 else overSoXSynthN24G n ampL1 v2 tts vec0 -- | Variant of the 'overSoXSynthN24G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. overSoXSynthN24GS :: Int -> Double -> Double -> String -> String -> V.Vector Double -> IO () overSoXSynthN24GS n ampL time3 zs = overSoXSynthN24G n ampL (str2Durations zs time3) -- | 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. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude -- for Overtones. If it is set to 1.0 the overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results -- in their becoming more silent ones. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. -- The third 'String' argument is used to define the intervals for the notes if any. -- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of -- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones. -- The last one is experimental feature. overSoXSynthN3 :: Int -> Double -> Double -> Double -> String -> String -> String -> V.Vector Double -> IO () overSoXSynthN3 n ampL time3 dAmpl zs = overSoXSynthN34G n ampL dAmpl (str2DurationsDef n zs time3) -- | Function to create a melody for the given arguments. 'Duraitons' is used to provide a rhythm. overSoXSynthN34G :: Int -> Double -> Double -> Durations -> String -> String -> V.Vector Double -> IO () overSoXSynthN34G n ampL dAmpl v2 tts vs vec0 | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let v21 = V.filter (/= 0.0) v2 m = V.length v21 zeroN = numVZeroesPre vec0 v3 = intervalsFromString vs l = length vs in V.imapM_ (\j x -> do let note0 = closestNote x -- zs is obtained from the command line arguments note1 = dNote (V.unsafeIndex v3 (j `rem` l)) note0 v0 = overTones2 note0 tts v1 = if isNothing note1 then V.empty else overTones2 (fromJust note1) tts overSoXSynthHelpN vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine",showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec overSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl * amplN * ampL > 1.0 then 1.0 else dAmpl * amplN * ampL) "" else "0"] "") vec soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note02 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / 2) "" else "0"] "" if isNothing note1 then do { soxSynthHelpMain0 note0 ; overSoXSynthHelpN v0 } else do { soxSynthHelpMain0 note0 ; soxSynthHelpMain1 (fromJust note1) ; overSoXSynthHelpN v0 ; overSoXSynthHelpN2 v1} paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result0" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) "" mapM_ removeFile paths) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then overSoXSynthN34G n 0.01 dAmpl v2 tts vs vec0 else overSoXSynthN34G n ampL1 dAmpl v2 tts vs vec0 -- | Generalized variant of the 'overSoXSynthN34G' where you specify your own 'Intervals'. For more information, please, refer to 'intervalsFromStringG'. overSoXSynthN35G :: Int -> Double -> Double -> Durations -> String -> Intervals -> V.Vector Double -> IO () overSoXSynthN35G n ampL dAmpl v2 tts v3 vec0 | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let v21 = V.filter (/=0.0) v2 m = V.length v21 zeroN = numVZeroesPre vec0 l = V.length v3 in V.imapM_ (\j x -> do let note0 = closestNote x -- zs is obtained from the command line arguments note1 = dNote (V.unsafeIndex v3 (j `rem` l)) note0 v0 = overTones2 note0 tts v1 = if isNothing note1 then V.empty else overTones2 (fromJust note1) tts overSoXSynthHelpN vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine",showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec overSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl * amplN * ampL > 1.0 then 1.0 else dAmpl * amplN * ampL) "" else "0"] "") vec soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note02 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / 2) "" else "0"] "" if isNothing note1 then do { soxSynthHelpMain0 note0 ; overSoXSynthHelpN v0 } else do { soxSynthHelpMain0 note0 ; soxSynthHelpMain1 (fromJust note1) ; overSoXSynthHelpN v0 ; overSoXSynthHelpN2 v1} paths0 <- listDirectory "." let paths = sort . filter (isPrefixOf "test") $ paths0 _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result0" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) "" mapM_ removeFile paths) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then overSoXSynthN35G n 0.01 dAmpl v2 tts v3 vec0 else overSoXSynthN35G n ampL1 dAmpl v2 tts v3 vec0 -- | Variant of the 'overSoXSynthN34G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. overSoXSynthN34GS :: Int -> Double -> Double -> Double -> String -> String -> String -> V.Vector Double -> IO () overSoXSynthN34GS n ampL time3 dAmpl zs = overSoXSynthN34G n ampL dAmpl (str2Durations zs time3) -- | Variant of the 'overSoXSynthN34G' where intervals are obtained from the basic 'Intervals' with the length no more than 29 and a Ukrainian text -- specified as the last 'String' argument so that you can produce 'Intervals' of the arbitrary length. For more information, please, refer to -- 'intervalsFromStringG' and 'strToIntG'. overSoXSynthN35GS :: Int -> Double -> Double -> Double -> String -> String -> Intervals -> String -> V.Vector Double -> IO () overSoXSynthN35GS n ampL time3 dAmpl zs tts v3 vs = overSoXSynthN35G n ampL dAmpl (str2Durations zs time3) tts (intervalsFromStringG v3 vs) -- | Similar to 'overSoXSynthN', 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]). The first 'Double' argument from -- the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the overTones amplitudes are just maximum ones, -- otherwise they are multiplied by the parameter and this results in their becoming more silent ones. -- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). 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. -- -- For better usage the 'FilePath' should be a filepath for the .wav file. overSoXSynthNGen :: FilePath -> Int -> Double -> Double -> String -> IO () overSoXSynthNGen file m = overSoXSynthNGenE file m 12 -- | Similar to 'overSoXSynthNGen', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained -- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'overSoXSynthNGen'. To obtain -- its modifications, please, use 2, 3, 4, 6, or 9. overSoXSynthNGenE :: FilePath -> Int -> Int -> Double -> Double -> String -> IO () overSoXSynthNGenE file m ku ampL time3 zs = do n <- duration1000 file nGenE4Gi n file m ku ampL (str2DurationsDef n zs time3) -- | Generalized version of the 'overSoXSynthNGenE' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGenEPar :: FilePath -> Params -> Double -> Double -> String -> IO () overSoXSynthNGenEPar file params ampL time3 zs = do n <- duration1000 file nGenE4GiPar n file params ampL (str2DurationsDef n zs time3) -- | Variant of the 'overSoXSynthNGenE4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. overSoXSynthNGenE4GS :: FilePath -> Int -> Int -> Double -> Double -> String -> IO () overSoXSynthNGenE4GS file m ku ampL time3 zs = do n <- duration1000 file nGenE4Gi n file m ku ampL (str2Durations zs time3) -- | Generalized version of the 'overSoXSynthNGenE4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGenE4GSPar :: FilePath -> Params -> Double -> Double -> String -> IO () overSoXSynthNGenE4GSPar file params ampL time3 zs = do n <- duration1000 file nGenE4GiPar n file params ampL (str2Durations zs time3) -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. nGenE4Gi :: Int -> FilePath -> Int -> Int -> Double -> Durations -> IO () nGenE4Gi n file m ku ampL v2 = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA overSoXSynthN4G n ampL v2 vecB endFromResult -- | Generalized version of the 'nGenE4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. nGenE4GiPar :: Int -> FilePath -> Params -> Double -> Durations -> IO () nGenE4GiPar n file params ampL v2 = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA overSoXSynthN4G n ampL v2 vecB endFromResult -- | 4G genaralized version of the 'overSoXSynthNGenE' where you provide your own 'Durations'. overSoXSynthNGenE4G :: FilePath -> Int -> Int -> Double -> Durations -> IO () overSoXSynthNGenE4G file m ku ampL v2 = do n <- duration1000 file nGenE4Gi n file m ku ampL v2 -- | Generalized version of the 'overSoXSynthNGenE4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGenE4GPar :: FilePath -> Params -> Double -> Durations -> IO () overSoXSynthNGenE4GPar file params ampL v2 = do n <- duration1000 file nGenE4GiPar n file params ampL v2 -- | Similar to 'overSoXSynthN2', 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]). The first 'Double' argument from -- the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the overTones amplitudes are just maximum ones, -- otherwise they are multiplied by the parameter and this results in their becoming more silent ones. -- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). 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. -- -- For better usage the 'FilePath' should be a filepath for the .wav file. -- The second 'String' argument is used to define signs of the harmonics coefficients in the generated sounds. overSoXSynthNGen2 :: FilePath -> Int -> Double -> Double -> String -> String -> IO () overSoXSynthNGen2 file m = overSoXSynthNGen2E file m 12 -- | Similar to 'overSoXSynthNGen2', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained -- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'overSoXSynthNGen2'. To obtain -- its modifications, please, use 2, 3, 4, 6, or 9. overSoXSynthNGen2E :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> IO () overSoXSynthNGen2E file m ku ampL time3 zs tts = do n <- duration1000 file nGen2E4Gi n file m ku ampL (str2DurationsDef n zs time3) tts -- | Generalized version of the 'overSoXSynthNGen2E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen2EPar :: FilePath -> Params -> Double -> Double -> String -> String -> IO () overSoXSynthNGen2EPar file params ampL time3 zs tts = do n <- duration1000 file nGen2E4GiPar n file params ampL (str2DurationsDef n zs time3) tts -- | Variant of the 'overSoXSynthNGen2E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. overSoXSynthNGen2E4GS :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> IO () overSoXSynthNGen2E4GS file m ku ampL time3 zs tts = do n <- duration1000 file nGen2E4Gi n file m ku ampL (str2Durations zs time3) tts -- | Generalized version of the 'overSoXSynthNGen2E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen2E4GSPar :: FilePath -> Params -> Double -> Double -> String -> String -> IO () overSoXSynthNGen2E4GSPar file params ampL time3 zs tts = do n <- duration1000 file nGen2E4GiPar n file params ampL (str2Durations zs time3) tts -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. nGen2E4Gi :: Int -> FilePath -> Int -> Int -> Double -> Durations -> String -> IO () nGen2E4Gi n file m ku ampL v2 tts = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA overSoXSynthN24G n ampL v2 tts vecB endFromResult -- | Generalized version of the 'nGen2E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. nGen2E4GiPar :: Int -> FilePath -> Params -> Double -> Durations -> String -> IO () nGen2E4GiPar n file params ampL v2 tts = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA overSoXSynthN24G n ampL v2 tts vecB endFromResult -- | 4G genaralized version of the 'overSoXSynthNGen2E' where you provide your own 'Durations'. overSoXSynthNGen2E4G :: FilePath -> Int -> Int -> Double -> Durations -> String -> IO () overSoXSynthNGen2E4G file m ku ampL v2 tts = do n <- duration1000 file nGen2E4Gi n file m ku ampL v2 tts -- | Generalized version of the 'overSoXSynthNGen2E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen2E4GPar :: FilePath -> Params -> Double -> Durations -> String -> IO () overSoXSynthNGen2E4GPar file params ampL v2 tts = do n <- duration1000 file nGen2E4GiPar n file params ampL v2 tts -- | Similar to 'overSoXSynthN2', 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]). The first 'Double' argument from -- the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the overTones amplitudes are just maximum ones, -- otherwise they are multiplied by the parameter and this results in their becoming more silent ones. -- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). 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. -- -- For better usage the 'FilePath' should be a filepath for the .wav file. -- The second 'String' argument is used to define signs of the harmonics coefficients in the generated sounds. -- The third 'String' argument is used to define the intervals for the notes if any. -- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of -- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones. -- The last one is experimental feature. overSoXSynthNGen3 :: FilePath -> Int -> Double -> Double -> Double -> String -> String -> String -> IO () overSoXSynthNGen3 file m = overSoXSynthNGen3E file m 12 -- | Similar to 'overSoXSynthNGen3', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained -- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'overSoXSynthNGen3'. To obtain -- its modifications, please, use 2, 3, 4, 6, or 9. overSoXSynthNGen3E :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> IO () overSoXSynthNGen3E file m ku ampL time3 dAmpl zs tts vs = do n <- duration1000 file nGen3E4Gi n file m ku ampL dAmpl (str2DurationsDef n zs time3) tts vs -- | Generalized version of the 'overSoXSynthNGen3E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3EPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> String -> IO () overSoXSynthNGen3EPar file params ampL time3 dAmpl zs tts vs = do n <- duration1000 file nGen3E4GiPar n file params ampL dAmpl (str2DurationsDef n zs time3) tts vs -- | Variant of the 'overSoXSynthNGen3E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. overSoXSynthNGen3E4GS :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> IO () overSoXSynthNGen3E4GS file m ku ampL time3 dAmpl zs tts vs = do n <- duration1000 file nGen3E4Gi n file m ku ampL dAmpl (str2Durations zs time3) tts vs -- | Generalized version of the 'overSoXSynthNGen3E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3E4GSPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> String -> IO () overSoXSynthNGen3E4GSPar file params ampL time3 dAmpl zs tts vs = do n <- duration1000 file nGen3E4GiPar n file params ampL dAmpl (str2Durations zs time3) tts vs -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. nGen3E4Gi :: Int -> FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> String -> IO () nGen3E4Gi n file m ku ampL dAmpl v2 tts vs = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA overSoXSynthN34G n ampL dAmpl v2 tts vs vecB endFromResult -- | Generalized version of the 'nGen3E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. nGen3E4GiPar :: Int -> FilePath -> Params -> Double -> Double -> Durations -> String -> String -> IO () nGen3E4GiPar n file params ampL dAmpl v2 tts vs = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA overSoXSynthN34G n ampL dAmpl v2 tts vs vecB endFromResult -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. nGen3E5Gi :: Int -> FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> Intervals -> IO () nGen3E5Gi n file m ku ampL dAmpl v2 tts v3 = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA overSoXSynthN35G n ampL dAmpl v2 tts v3 vecB endFromResult -- | Generalized version of the 'nGen3E5Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. nGen3E5GiPar :: Int -> FilePath -> Params -> Double -> Double -> Durations -> String -> Intervals -> IO () nGen3E5GiPar n file params ampL dAmpl v2 tts v3 = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA overSoXSynthN35G n ampL dAmpl v2 tts v3 vecB endFromResult -- | 4G generalized function for 'overSoXSynthNGen3E' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. overSoXSynthNGen3E4G :: FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> String -> IO () overSoXSynthNGen3E4G file m ku ampL dAmpl v2 tts vs = do n <- duration1000 file nGen3E4Gi n file m ku ampL dAmpl v2 tts vs -- | Generalized version of the 'overSoXSynthNGen3E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3E4GPar :: FilePath -> Params -> Double -> Double -> Durations -> String -> String -> IO () overSoXSynthNGen3E4GPar file params ampL dAmpl v2 tts vs = do n <- duration1000 file nGen3E4GiPar n file params ampL dAmpl v2 tts vs -- | 5G generalized function for 'overSoXSynthNGen3E4G' where you provide your own 'Intervals'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. overSoXSynthNGen3E5G :: FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> Intervals -> IO () overSoXSynthNGen3E5G file m ku ampL dAmpl v2 tts v3 = do n <- duration1000 file nGen3E5Gi n file m ku ampL dAmpl v2 tts v3 -- | Generalized version of the 'overSoXSynthNGen3E5G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3E5GPar :: FilePath -> Params -> Double -> Double -> Durations -> String -> Intervals -> IO () overSoXSynthNGen3E5GPar file params ampL dAmpl v2 tts v3 = do n <- duration1000 file nGen3E5GiPar n file params ampL dAmpl v2 tts v3 -- | Variant of the 'overSoXSynthNGen3E5G' where 'Intervals' are obtained from the basic 'Intervals' with the length no more than 29 and a Ukrainian text -- specified as the last 'String' argument so that you can produce 'Intervals' of the arbitrary length. For more information, please, refer to -- 'intervalsFromStringG' and 'strToIntG'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. overSoXSynthNGen3E5GS :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> Intervals -> String -> IO () overSoXSynthNGen3E5GS file m ku ampL time3 dAmpl zs tts v3 vs = do n <- duration1000 file nGen3E5Gi n file m ku ampL dAmpl (str2Durations zs time3) tts (intervalsFromStringG v3 vs) -- | Generalized version of the 'overSoXSynthNGen3E5GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3E5GSPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> Intervals -> String -> IO () overSoXSynthNGen3E5GSPar file params ampL time3 dAmpl zs tts v3 vs = do n <- duration1000 file nGen3E5GiPar n file params ampL dAmpl (str2Durations zs time3) tts (intervalsFromStringG v3 vs) -- | 6G generalized function for 'overSoXSynthNGen3E5G' where you provide your own 'Strengths'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. overSoXSynthNGen3E6G :: FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> Intervals -> Strengths -> Double -> IO () overSoXSynthNGen3E6G file m ku ampL dAmpl v2 tts v3 v6 limV = overSoXSynthNGen3E5G file m ku ampL dAmpl v2 tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult -- | Generalized version of the 'overSoXSynthNGen3E6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3E6GPar :: FilePath -> Params -> Double -> Double -> Durations -> String -> Intervals -> Strengths -> Double -> IO () overSoXSynthNGen3E6GPar file params ampL dAmpl v2 tts v3 v6 limV = overSoXSynthNGen3E5GPar file params ampL dAmpl v2 tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult -- | A variant of 'overSoXSynthNGen3E6G' where 'Strengths' are obtained from a Ukrainian text specified as the last 'String' argument. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. overSoXSynthNGen3E6GS :: FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> Intervals -> String -> Double -> IO () overSoXSynthNGen3E6GS file m ku ampL dAmpl v2 tts v3 xxs limV = overSoXSynthNGen3E6G file m ku ampL dAmpl v2 tts v3 (str2Volume xxs) limV -- | Generalized version of the 'overSoXSynthNGen3E6GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3E6GSPar :: FilePath -> Params -> Double -> Double -> Durations -> String -> Intervals -> String -> Double -> IO () overSoXSynthNGen3E6GSPar file params ampL dAmpl v2 tts v3 xxs limV = overSoXSynthNGen3E6GPar file params ampL dAmpl v2 tts v3 (str2Volume xxs) limV -- | A variant of 'overSoXSynthNGen3E6GS' where 'Strengths' and 'Durations' are obtained from the same Ukrainian text specified as -- the last 'String' argument. The third 'Double' argument is an average duration of the sounds in seconds. -- Note that 'Int' arguments are used by 'liftInEnku' in that order so it returns a 'Maybe' number (actually frequency) for -- the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. overSoXSynthNGen3E6GSu :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> Intervals -> String -> Double -> IO () overSoXSynthNGen3E6GSu file m ku ampL dAmpl time3 tts v3 xxs = overSoXSynthNGen3E6G file m ku ampL dAmpl (str2Durations xxs time3) tts v3 (str2Volume xxs) -- | Generalized version of the 'overSoXSynthNGen3E6GSu' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthNGen3E6GSuPar :: FilePath -> Params -> Double -> Double -> Double -> String -> Intervals -> String -> Double -> IO () overSoXSynthNGen3E6GSuPar file params ampL dAmpl time3 tts v3 xxs = overSoXSynthNGen3E6GPar file params ampL dAmpl (str2Durations xxs time3) tts v3 (str2Volume xxs) -- | 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. Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. uniqOverSoXSynth :: Double -> String -> IO () uniqOverSoXSynth x wws = do let note0 = closestNote x note1 = pureQuintNote note0 v0 = uniqOvertonesV note0 wws v1 = uniqOvertonesV note1 wws _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test-.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 "", "synth", "0.5","sine", "mix", showFFloat (Just 4) note1 "", "vol","0.5"] "" uniqOverSoXSynthHelp v0 uniqOverSoXSynthHelp2 v1 mixTest uniqOverSoXSynthHelp1 :: String -> OvertonesO -> IO () uniqOverSoXSynthHelp1 xs = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", xs ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN "", "vol", showFFloat (Just 4) amplN ""] "") uniqOverSoXSynthHelp :: OvertonesO -> IO () uniqOverSoXSynthHelp = uniqOverSoXSynthHelp1 "test0" uniqOverSoXSynthHelp2 :: OvertonesO -> IO () uniqOverSoXSynthHelp2 = uniqOverSoXSynthHelp1 "test1" -- | 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. Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. -- The second 'String' argument is used to define signs for the harmonics coefficients for Overtones. uniqOverSoXSynth2 :: Double -> String -> String -> IO () uniqOverSoXSynth2 x wws tts = do let note0 = closestNote x note1 = pureQuintNote note0 v0 = uniqOvertonesV2 note0 wws tts v1 = uniqOvertonesV2 note1 wws tts _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test-.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 "", "synth", "0.5","sine", "mix", showFFloat (Just 4) note1 "", "vol","0.5"] "" uniqOverSoXSynthHelp v0 uniqOverSoXSynthHelp2 v1 mixTest -- | 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 first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. -- If it is set to 1.0 the overTones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in -- their becoming more silent ones. 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. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. uniqOverSoXSynthN :: Int -> Double -> Double -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN n ampL time3 zs = uniqOverSoXSynthN4G n ampL (str2DurationsDef n zs time3) -- | Variant of the 'uniqOverSoXSynthN4G' function where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. uniqOverSoXSynthN4GS :: Int -> Double -> Double -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN4GS n ampL time3 zs = uniqOverSoXSynthN4G n ampL (str2Durations zs time3) -- | 4G generalized variant of the 'uniqOverSoXSynthN' where you specify your own 'Durations'. uniqOverSoXSynthN4G :: Int -> Double -> Durations -> String -> V.Vector Double -> IO () uniqOverSoXSynthN4G n ampL v2 wws vec0 | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let v21 = V.filter (/= 0.0) v2 m = V.length v21 zeroN = numVZeroesPre vec0 in V.imapM_ (\j x -> do let note0 = closestNote x note1 = pureQuintNote note0 v0 = uniqOvertonesV note0 wws v1 = uniqOvertonesV note1 wws uniqOverSoXSynthHelpN = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") uniqOverSoXSynthHelpN2 = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) "","sine", "mix", showFFloat (Just 4) note02 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain note0 note1 uniqOverSoXSynthHelpN v0 uniqOverSoXSynthHelpN2 v1 mixTest2 zeroN j) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then uniqOverSoXSynthN4G n 0.01 v2 wws vec0 else uniqOverSoXSynthN4G n ampL1 v2 wws vec0 -- | 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 first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. -- If it is set to 1.0 the overTones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in -- their becoming more silent ones. 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. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. -- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds. uniqOverSoXSynthN3 :: Int -> Double -> Double -> String -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN3 n ampL time3 zs = uniqOverSoXSynthN34G n ampL (str2DurationsDef n zs time3) -- | Variant of the 'uniqOverSoXSynthN34G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. uniqOverSoXSynthN34GS :: Int -> Double -> Double -> String -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN34GS n ampL time3 zs = uniqOverSoXSynthN34G n ampL (str2Durations zs time3) -- | 4G generalized variant of the 'uniqOverSoXSynthN3' where you specify your own 'Durations'. uniqOverSoXSynthN34G :: Int -> Double -> Durations -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN34G n ampL v2 wws tts vec0 | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let v21 = V.filter (/=0.0) v2 m = V.length v2 zeroN = numVZeroesPre vec0 in 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 = uniqOvertonesV2 note0 wws tts v1 = uniqOvertonesV2 note1 wws tts uniqOverSoXSynthHelpN vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec uniqOverSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") vec soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", "mix", showFFloat (Just 4) note02 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain note0 note1 uniqOverSoXSynthHelpN v0 uniqOverSoXSynthHelpN2 v1 mixTest2 zeroN j) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then uniqOverSoXSynthN34G n 0.01 v2 wws tts vec0 else uniqOverSoXSynthN34G n ampL1 v2 wws tts vec0 -- | 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 first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. -- If it is set to 1.0 the overTones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in -- their becoming more silent ones. 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. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten. -- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds. -- The fourth 'String' argument is used to define the intervals for the notes if any. -- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of -- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones. -- The last one is experimental feature. uniqOverSoXSynthN4 :: Int -> Double -> Double -> Double -> String -> String -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN4 n ampL time3 dAmpl zs = uniqOverSoXSynthN44G n ampL dAmpl (str2DurationsDef n zs time3) -- | Variant of the 'uniqOverSoXSynthN44G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. uniqOverSoXSynthN44GS :: Int -> Double -> Double -> Double -> String -> String -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN44GS n ampL time3 dAmpl zs = uniqOverSoXSynthN44G n ampL dAmpl (str2Durations zs time3) -- | 4G generalized variant of the 'uniqOverSoXSynthN4' where you specify your own 'Durations'. uniqOverSoXSynthN44G :: Int -> Double -> Double -> Durations -> String -> String -> String -> V.Vector Double -> IO () uniqOverSoXSynthN44G n ampL dAmpl v2 wws tts vs = uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts (intervalsFromString vs) -- | 5G generalized variant of the 'uniqOverSoXSynthN44G' where you specify your own 'Intervals'. uniqOverSoXSynthN45G :: Int -> Double -> Double -> Durations -> String -> String -> Intervals -> V.Vector Double -> IO () uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts v3 vec0 | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let v21 = V.filter (/=0.0) v2 m = V.length v2 zeroN = numVZeroesPre vec0 l = V.length v3 in V.imapM_ (\j x -> do let note0 = closestNote x note1 = dNote (V.unsafeIndex v3 (j `rem` l)) note0 v0 = uniqOvertonesV2 note0 wws tts v1 = if isNothing note1 then V.empty else uniqOvertonesV2 (fromJust note1) wws tts uniqOverSoXSynthHelpN = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine",showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") uniqOverSoXSynthHelpN2 = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl * amplN * ampL > 1.0 then 1.0 else dAmpl * amplN * ampL) "" else "0"] "") soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "vol",if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note02 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / 2) "" else "0"] "" if isNothing note1 then do { soxSynthHelpMain0 note0 ; uniqOverSoXSynthHelpN v0 } else do { soxSynthHelpMain0 note0 ; soxSynthHelpMain1 (fromJust note1) ; uniqOverSoXSynthHelpN v0 ; uniqOverSoXSynthHelpN2 v1} mixTest2 zeroN j) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then uniqOverSoXSynthN45G n 0.01 dAmpl v2 wws tts v3 vec0 else uniqOverSoXSynthN45G n ampL1 dAmpl v2 wws tts v3 vec0 -- | 6G generalized variant of the 'uniqOverSoXSynthN45G' where you specify your own 'Strengths' and a limit (as the last 'Double') when less volume level -- sound files are treated as a silent ones and are not adjusted. uniqOverSoXSynthN46G :: Int -> Double -> Double -> Durations -> String -> String -> Intervals -> V.Vector Double -> Strengths -> Double -> IO () uniqOverSoXSynthN46G n ampL dAmpl v2 wws tts v3 vec0 v6 limV | V.all (== 0.0) v2 = putStrLn "You provided no valid durations data! " | V.null v6 = putStrLn "You did not provide a volume adjustments vector! " | compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT = let v21 = V.filter (/=0.0) v2 m = V.length v2 zeroN = numVZeroesPre vec0 l = V.length v3 in V.imapM_ (\j x -> do let note0 = closestNote x note1 = dNote (V.unsafeIndex v3 (j `rem` l)) note0 v0 = uniqOvertonesV2 note0 wws tts v1 = if isNothing note1 then V.empty else uniqOvertonesV2 (fromJust note1) wws tts uniqOverSoXSynthHelpN = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine",showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") uniqOverSoXSynthHelpN2 = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "", "sine", showFFloat (Just 4) noteN "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl * amplN * ampL > 1.0 then 1.0 else dAmpl * amplN * ampL) "" else "0"] "") soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "vol",if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then "0.5" else "0"] "" soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (V.unsafeIndex v21 (j `rem` m))) "","sine", showFFloat (Just 4) note02 "", "vol", if compare (V.unsafeIndex v21 (j `rem` m)) 0.0 == GT then showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / 2) "" else "0"] "" if isNothing note1 then do { soxSynthHelpMain0 note0 ; uniqOverSoXSynthHelpN v0 } else do { soxSynthHelpMain0 note0 ; soxSynthHelpMain1 (fromJust note1) ; uniqOverSoXSynthHelpN v0 ; uniqOverSoXSynthHelpN2 v1} mixTest2 zeroN j apply6GSilentFile ("result" ++ prependZeroes zeroN (show j) ++ ".wav") limV (V.unsafeIndex v6 (j `rem` V.length v6))) vec0 | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in if abs ampL1 < 0.01 then uniqOverSoXSynthN46G n 0.01 dAmpl v2 wws tts v3 vec0 v6 limV else uniqOverSoXSynthN46G n ampL1 dAmpl v2 wws tts v3 vec0 v6 limV -- | Variant of the 'uniqOverSoXSynthN45G' where 'Intervals' are obtained from the 'String' using 'intervalsFromStringG' function. Helps to create a speech-like -- composition. uniqOverSoXSynthN45GS :: Int -> Double -> Double -> Double -> String -> String -> String -> Intervals -> String -> V.Vector Double -> IO () uniqOverSoXSynthN45GS n ampL time3 dAmpl zs wws tts v3 vs = uniqOverSoXSynthN45G n ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v3 vs) -- | Variant of the 'uniqOverSoXSynthN46G' where 'Strengths' are obtained from the 'String' using 'str2Volume' function. Helps to create a speech-like -- composition. uniqOverSoXSynthN46GS :: Int -> Double -> Double -> Double -> String -> String -> String -> Intervals -> String -> V.Vector Double -> String -> Double -> IO () uniqOverSoXSynthN46GS n ampL time3 dAmpl zs wws tts v3 vs vec0 xxs limV = uniqOverSoXSynthN46G n ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v3 vs) vec0 (str2Volume xxs) limV -- | A variant of 'uniqOverSoXSynthN46GS' where 'Strengths' and 'Durations' are obtained from the same Ukrainian text specified as -- the last 'String' argument. The second 'Double' argument is an average duration of the sounds in seconds. -- Note that 'Int' arguments are used by 'liftInEnku' in that order so it returns a 'Maybe' number (actually frequency) for -- the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthN46GSu :: Int -> Double -> Double -> Double -> String -> String -> Intervals -> String -> V.Vector Double -> String -> Double -> IO () uniqOverSoXSynthN46GSu n ampL time3 dAmpl wws tts v5 vs vec0 xxs limV = uniqOverSoXSynthN46G n ampL dAmpl (str2Durations xxs time3) wws tts (intervalsFromStringG v5 vs) vec0 (str2Volume xxs) limV -- | Similar to 'uniqOverSoXSynthN', 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]). -- The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the -- overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones. -- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). 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. -- -- For better usage the 'FilePath' should be a filepath for the .wav file. uniqOverSoXSynthNGen :: FilePath -> Int -> Double -> Double -> String -> String -> IO () uniqOverSoXSynthNGen file m = uniqOverSoXSynthNGenE file m 12 -- | Similar to 'uniqOverSoXSynthNGen', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained -- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'uniqOverSoXSynthNGen'. To obtain -- its modifications, please, use 2, 3, 4, 6, or 9. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGenE :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> IO () uniqOverSoXSynthNGenE file m ku ampL time3 zs wws = do n <- duration1000 file unGenNE4Gi n file m ku ampL (str2DurationsDef n zs time3) wws -- | Generalized version of the 'uniqOverSoXSynthNGenE' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGenEPar :: FilePath -> Params -> Double -> Double -> String -> String -> IO () uniqOverSoXSynthNGenEPar file params ampL time3 zs wws = do n <- duration1000 file unGenNE4GiPar n file params ampL (str2DurationsDef n zs time3) wws -- | Variant of the 'uniqOverSoXSynthNGenE4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGenE4GS :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> IO () uniqOverSoXSynthNGenE4GS file m ku ampL time3 zs wws = do n <- duration1000 file unGenNE4Gi n file m ku ampL (str2Durations zs time3) wws -- | Generalized version of the 'uniqOverSoXSynthNGenE4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGenE4GSPar :: FilePath -> Params -> Double -> Double -> String -> String -> IO () uniqOverSoXSynthNGenE4GSPar file params ampL time3 zs wws = do n <- duration1000 file unGenNE4GiPar n file params ampL (str2Durations zs time3) wws -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. unGenNE4Gi :: Int -> FilePath -> Int -> Int -> Double -> Durations -> String -> IO () unGenNE4Gi n file m ku ampL v2 wws = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA uniqOverSoXSynthN4G n ampL v2 wws vecB endFromResult -- | Generalized version of the 'unGenNE4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. unGenNE4GiPar :: Int -> FilePath -> Params -> Double -> Durations -> String -> IO () unGenNE4GiPar n file params ampL v2 wws = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA uniqOverSoXSynthN4G n ampL v2 wws vecB endFromResult -- | 4G genaralized version of the 'uniqOverSoXSynthNGenE' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGenE4G :: FilePath -> Int -> Int -> Double -> Durations -> String -> IO () uniqOverSoXSynthNGenE4G file m ku ampL v2 wws = do n <- duration1000 file unGenNE4Gi n file m ku ampL v2 wws -- | Generalized version of the 'uniqOverSoXSynthNGenE4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGenE4GPar :: FilePath -> Params -> Double -> Durations -> String -> IO () uniqOverSoXSynthNGenE4GPar file params ampL v2 wws = do n <- duration1000 file unGenNE4GiPar n file params ampL v2 wws -- | Similar to 'uniqOverSoXSynthN', 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]). -- The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the -- overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones. -- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). 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. -- -- For better usage the 'FilePath' should be a filepath for the .wav file. -- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds. uniqOverSoXSynthNGen3 :: FilePath -> Int -> Double -> Double -> String -> String -> String -> IO () uniqOverSoXSynthNGen3 file m = uniqOverSoXSynthNGen3E file m 12 -- | Similar to 'uniqOverSoXSynthNGen3', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained -- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'uniqOverSoXSynthNGen3'. To obtain -- its modifications, please, use 2, 3, 4, 6, or 9. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen3E :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> String -> IO () uniqOverSoXSynthNGen3E file m ku ampL time3 zs wws tts = do n <- duration1000 file unGenN3E4Gi n file m ku ampL (str2DurationsDef n zs time3) wws tts -- | Generalized version of the 'uniqOverSoXSynthNGen3E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen3EPar :: FilePath -> Params -> Double -> Double -> String -> String -> String -> IO () uniqOverSoXSynthNGen3EPar file params ampL time3 zs wws tts = do n <- duration1000 file unGenN3E4GiPar n file params ampL (str2DurationsDef n zs time3) wws tts -- | Variant of the 'uniqOverSoXSynthNGen3E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen3E4GS :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> String -> IO () uniqOverSoXSynthNGen3E4GS file m ku ampL time3 zs wws tts = do n <- duration1000 file unGenN3E4Gi n file m ku ampL (str2Durations zs time3) wws tts -- | Generalized version of the 'uniqOverSoXSynthNGen3E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen3E4GSPar :: FilePath -> Params -> Double -> Double -> String -> String -> String -> IO () uniqOverSoXSynthNGen3E4GSPar file params ampL time3 zs wws tts = do n <- duration1000 file unGenN3E4GiPar n file params ampL (str2Durations zs time3) wws tts -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. unGenN3E4Gi :: Int -> FilePath -> Int -> Int -> Double -> Durations -> String -> String -> IO () unGenN3E4Gi n file m ku ampL v2 wws tts = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA uniqOverSoXSynthN34G n ampL v2 wws tts vecB endFromResult -- | Generalized version of the 'unGenN3E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. unGenN3E4GiPar :: Int -> FilePath -> Params -> Double -> Durations -> String -> String -> IO () unGenN3E4GiPar n file params ampL v2 wws tts = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA uniqOverSoXSynthN34G n ampL v2 wws tts vecB endFromResult -- | 4G genaralized version of the 'uniqOverSoXSynthNGen3E' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen3E4G :: FilePath -> Int -> Int -> Double -> Durations -> String -> String -> IO () uniqOverSoXSynthNGen3E4G file m ku ampL v2 wws tts = do n <- duration1000 file unGenN3E4Gi n file m ku ampL v2 wws tts -- | Generalized version of the 'uniqOverSoXSynthNGen3E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen3E4GPar :: FilePath -> Params -> Double -> Durations -> String -> String -> IO () uniqOverSoXSynthNGen3E4GPar file params ampL v2 wws tts = do n <- duration1000 file unGenN3E4GiPar n file params ampL v2 wws tts -- | Similar to 'uniqOverSoXSynthN', 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]). -- The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the -- overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones. -- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). 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. -- -- For better usage the 'FilePath' should be a filepath for the .wav file. -- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds. -- The fourth 'String' argument is used to define the intervals for the notes if any. -- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of -- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones. -- The last one is an experimental feature. uniqOverSoXSynthNGen4 :: FilePath -> Int -> Double -> Double -> Double -> String -> String -> String -> String -> IO () uniqOverSoXSynthNGen4 file m = uniqOverSoXSynthNGen4E file m 12 -- | Similar to 'uniqOverSoXSynthNGen4', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained -- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'uniqOverSoXSynthNGen4'. To obtain -- its modifications, please, use 2, 3, 4, 6, or 9. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> String -> IO () uniqOverSoXSynthNGen4E file m ku ampL time3 dAmpl zs wws tts vs = do n <- duration1000 file unGenN4E4Gi n file m ku ampL dAmpl (str2DurationsDef n zs time3) wws tts vs -- | Generalized version of the 'uniqOverSoXSynthNGen4E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4EPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> String -> String -> IO () uniqOverSoXSynthNGen4EPar file params ampL time3 dAmpl zs wws tts vs = do n <- duration1000 file unGenN4E4GiPar n file params ampL dAmpl (str2DurationsDef n zs time3) wws tts vs -- | Variant of the 'uniqOverSoXSynthNGen4E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like -- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E4GS :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> String -> IO () uniqOverSoXSynthNGen4E4GS file m ku ampL time3 dAmpl zs wws tts vs = do n <- duration1000 file unGenN4E4Gi n file m ku ampL dAmpl (str2Durations zs time3) wws tts vs -- | Generalized version of the 'uniqOverSoXSynthNGen4E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4E4GSPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> String -> String -> IO () uniqOverSoXSynthNGen4E4GSPar file params ampL time3 dAmpl zs wws tts vs = do n <- duration1000 file unGenN4E4GiPar n file params ampL dAmpl (str2Durations zs time3) wws tts vs -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. unGenN4E4Gi :: Int -> FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> String -> String -> IO () unGenN4E4Gi n file m ku ampL dAmpl v2 wws tts vs = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA uniqOverSoXSynthN44G n ampL dAmpl v2 wws tts vs vecB endFromResult -- | Generalized version of the 'unGenN4E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. unGenN4E4GiPar :: Int -> FilePath -> Params -> Double -> Double -> Durations -> String -> String -> String -> IO () unGenN4E4GiPar n file params ampL dAmpl v2 wws tts vs = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA uniqOverSoXSynthN44G n ampL dAmpl v2 wws tts vs vecB endFromResult -- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@. unGenN4E5Gi :: Int -> FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> String -> Intervals -> IO () unGenN4E5Gi n file m ku ampL dAmpl v2 wws tts v3 = do vecA <- freqsFromFile file n let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts v3 vecB endFromResult -- | Generalized version of the 'unGenN4E5Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. unGenN4E5GiPar :: Int -> FilePath -> Params -> Double -> Double -> Durations -> String -> String -> Intervals -> IO () unGenN4E5GiPar n file params ampL dAmpl v2 wws tts v3 = do vecA <- freqsFromFile file n let vecB = liftInParamsV params . V.map fromIntegral $ vecA uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts v3 vecB endFromResult -- | 4G genaralized version of the 'uniqOverSoXSynthNGen4E' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E4G :: FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> String -> String -> IO () uniqOverSoXSynthNGen4E4G file m ku ampL dAmpl v2 wws tts vs = do n <- duration1000 file unGenN4E4Gi n file m ku ampL dAmpl v2 wws tts vs -- | Generalized version of the 'uniqOverSoXSynthNGen4E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4E4GPar :: FilePath -> Params -> Double -> Double -> Durations -> String -> String -> String -> IO () uniqOverSoXSynthNGen4E4GPar file params ampL dAmpl v2 wws tts vs = do n <- duration1000 file unGenN4E4GiPar n file params ampL dAmpl v2 wws tts vs -- | 5G genaralized version of the 'uniqOverSoXSynthNGen4E' where you provide your own 'Durations' and 'Intervals'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E5G :: FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> String -> Intervals -> IO () uniqOverSoXSynthNGen4E5G file m ku ampL dAmpl v2 wws tts v3 = do n <- duration1000 file unGenN4E5Gi n file m ku ampL dAmpl v2 wws tts v3 -- | Generalized version of the 'uniqOverSoXSynthNGen4E5G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4E5GPar :: FilePath -> Params -> Double -> Double -> Durations -> String -> String -> Intervals -> IO () uniqOverSoXSynthNGen4E5GPar file params ampL dAmpl v2 wws tts v3 = do n <- duration1000 file unGenN4E5GiPar n file params ampL dAmpl v2 wws tts v3 -- | Variant of the 'uniqOverSoXSynthNGen4E5G' where 'Intervals' are obtained from the 'String' using 'intervalsFromStringG' function. Helps to create a speech-like -- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E5GS :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> Intervals -> String -> IO () uniqOverSoXSynthNGen4E5GS file m ku ampL time3 dAmpl zs wws tts v3 vs = do n <- duration1000 file unGenN4E5Gi n file m ku ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v3 vs) -- | Generalized version of the 'uniqOverSoXSynthNGen4E5GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4E5GSPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> String -> Intervals -> String -> IO () uniqOverSoXSynthNGen4E5GSPar file params ampL time3 dAmpl zs wws tts v3 vs = do n <- duration1000 file unGenN4E5GiPar n file params ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v3 vs) -- | 6G generalized function for 'uniqOverSoXSynthNGen4E5G' where you provide your own 'Strengths'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E6G :: FilePath -> Int -> Int -> Double -> Double -> Durations -> String -> String -> Intervals -> Strengths -> Double -> IO () uniqOverSoXSynthNGen4E6G file m ku ampL dAmpl v2 wws tts v3 v6 limV = uniqOverSoXSynthNGen4E5G file m ku ampL dAmpl v2 wws tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult -- | Generalized version of the 'uniqOverSoXSynthNGen4E6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4E6GPar :: FilePath -> Params -> Double -> Double -> Durations -> String -> String -> Intervals -> Strengths -> Double -> IO () uniqOverSoXSynthNGen4E6GPar file params ampL dAmpl v2 wws tts v3 v6 limV = uniqOverSoXSynthNGen4E5GPar file params ampL dAmpl v2 wws tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult -- | A variant of 'uniqOverSoXSynthNGen4E6G' where 'Strengths' are obtained from a Ukrainian text specified as the last 'String' argument. Note that 'Int' arguments are used by 'liftInEnku' in that order so it -- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E6GS :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> Intervals -> String -> String -> Double -> IO () uniqOverSoXSynthNGen4E6GS file m ku ampL time3 dAmpl zs wws tts v5 vs xxs limV = uniqOverSoXSynthNGen4E6G file m ku ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV -- | Generalized version of the 'uniqOverSoXSynthNGen4E6GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4E6GSPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> String -> Intervals -> String -> String -> Double -> IO () uniqOverSoXSynthNGen4E6GSPar file params ampL time3 dAmpl zs wws tts v5 vs xxs limV = uniqOverSoXSynthNGen4E6GPar file params ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV -- | A variant of 'uniqOverSoXSynthNGen4E6GS' where 'Strengths' and 'Durations' are obtained from the same Ukrainian text specified as -- the last 'String' argument. The second 'Double' argument is an average duration of the sounds in seconds. -- Note that 'Int' arguments are used by 'liftInEnku' in that order so it returns a 'Maybe' number (actually frequency) for -- the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@. uniqOverSoXSynthNGen4E6GSu :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> Intervals -> String -> String -> Double -> IO () uniqOverSoXSynthNGen4E6GSu file m ku ampL time3 dAmpl wws tts v5 vs xxs limV = uniqOverSoXSynthNGen4E6G file m ku ampL dAmpl (str2Durations xxs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV -- | Generalized version of the 'uniqOverSoXSynthNGen4E6GSu' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. uniqOverSoXSynthNGen4E6GSuPar :: FilePath -> Params -> Double -> Double -> Double -> String -> String -> Intervals -> String -> String -> Double -> IO () uniqOverSoXSynthNGen4E6GSuPar file params ampL time3 dAmpl wws tts v5 vs xxs limV = uniqOverSoXSynthNGen4E6GPar file params ampL dAmpl (str2Durations xxs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV