diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -379,3 +379,10 @@ * Fourtieth version. Added mmsyn7l as a dependency. Moved some functions from DobutokO.Sound.IntermediateF module to MMSyn7l module. This allows to use their functionality without necessary installation of the dobutokO2 package (only mmsyn7* series using). + +## 0.41.0.0 -- 2020-05-20 + +* Fourty-first version. Completely changed the modules structure added new ones and rearranged the existing, module DobutokO.Sound splitted into three +different modules: DobutokO.Sound.Overtones, DobutokO.Sound.Uniq and DobutokO.Sound.Octaves. This was done to simplify compilation and to produce more +logical and semantic structure. The most complicated functions from DobutokO.Sound.Functional module are moved to a new package dobutokO3. Some code +improvements. diff --git a/DobutokO/Sound.hs b/DobutokO/Sound.hs deleted file mode 100644 --- a/DobutokO/Sound.hs +++ /dev/null @@ -1,1421 +0,0 @@ --- | --- 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 diff --git a/DobutokO/Sound/DIS5G6G.hs b/DobutokO/Sound/DIS5G6G.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/DIS5G6G.hs @@ -0,0 +1,162 @@ +-- | +-- Module : DobutokO.Sound.DIS5G6G +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.DIS5G6G ( + -- ** Auxiliary functions + syllableStr + -- *** Working with Intervals, Durations, Strengths and StrengthDb + , intervalsFromString + , vStrToVInt + , strToInt + , durationsAver + , str2Durat1 + , str2Durations + , str2Vol1 + , str2Volume + , doublesAveragedA + , doublesAveragedG + , equalize2Vec + , intervalsFromStringG + , silentSound2G + , strengthsAver + , strengthsDbAver + -- * New generalized 6G functions that works with Strengths + , apply6G + , apply6G2 + , apply6GS + , apply6GS2 +) where + +import CaseBi (getBFst') +import Numeric +import Data.Maybe (fromJust) +import qualified Data.Vector as V +import System.Process +import EndOfExe +import Melodics.Ukrainian (convertToProperUkrainian) +import MMSyn7l +import DobutokO.Sound.IntermediateF +import DobutokO.Sound.Functional.Params +import DobutokO.Sound.Decibel + +-- | Generatlized version of the 'intervalsFromString' with a possibility to specify your own 'Intervals'. +intervalsFromStringG :: Intervals -> String -> Intervals +intervalsFromStringG v = vStrToVIntG v . convertToProperUkrainian + +-- | The default way to get 'Intervals' from a converted Ukrainian text. +vStrToVInt :: V.Vector String -> Intervals +vStrToVInt = V.map (strToIntG defInt) + +-- | The default way to get number of semi-tones between notes in a single element of 'Intervals'. +strToInt :: String -> Int +strToInt = strToIntG defInt +{-# INLINE strToInt #-} + +--------------------------------------------------------------------------------------------------------------------- + +-- | Arithmetic average for the 'V.Vector' is used as a weight for a duration. +doublesAveragedA :: V.Vector Double -> Double -> V.Vector Double +doublesAveragedA v4 y3 + | V.null v4 || y3 == 0 = V.empty + | otherwise = let aver = V.sum v4 / fromIntegral (V.length v4) in if aver == 0.0 then doublesAveragedA (V.filter (/= 0.0) v4) y3 + else V.map (\t4 -> t4 * y3 / aver) v4 + +-- | Geometric average for the 'V.Vector' is used as a weight for a strength. +doublesAveragedG :: V.Vector Double -> Double -> V.Vector Double +doublesAveragedG v4 y3 + | V.null v4 || y3 == 0 = V.empty + | otherwise = let aver = V.product v4 ** (fromIntegral 1 / (fromIntegral (V.length v4))) in if aver == 0.0 then doublesAveragedG (V.filter (/= 0.0) v4) y3 + else V.map (\t4 -> t4 * y3 / aver) v4 + +-- | 'Durations' accounting the desired average duration. +durationsAver :: Durations -> Double -> Durations +durationsAver = doublesAveragedA + +-- | 'Strengths' accounting the desired average strength. +strengthsAver :: Strengths -> Double -> Strengths +strengthsAver = doublesAveragedG + +-- | 'StrengthsDb' accounting the desired average strength in dB. +strengthsDbAver :: StrengthsDb -> Double -> StrengthsDb +strengthsDbAver = doublesAveragedG + +-- | Auxiliar function to make all vectors in a 'V.Vector' equal by length (the minimum one). +equalize2Vec :: V.Vector (V.Vector a) -> V.Vector (V.Vector a) +equalize2Vec v = let min = V.minimum . V.map V.length $ v in V.map (V.unsafeSlice 0 min) v + +-- | A full conversion to the 'Durations' from a Ukrainian text. +str2Durations :: String -> Double -> Durations +str2Durations xs y + | compare y 0.0 == GT && not (null xs) = durationsAver (V.map str2Durat1 . convertToProperUkrainian $ xs) y + | otherwise = V.empty + +-- | A conversion to the 'Double' that is used inside 'str2Durations'. +str2Durat1 :: String -> Double +str2Durat1 = getBFst' ((-0.153016), V.fromList [("-", (-0.101995)), ("0", (-0.051020)), ("1", (-0.153016)), ("а", 0.138231), ("б", 0.057143), + ("в", 0.082268), ("г", 0.076825), ("д", 0.072063), ("дж", 0.048934), ("дз", 0.055601), ("е", 0.093605), ("ж", 0.070658), ("з", 0.056054), + ("и", 0.099955), ("й", 0.057143), ("к", 0.045351), ("л", 0.064036), ("м", 0.077370), ("н", 0.074240), ("о", 0.116463), ("п", 0.134830), + ("р", 0.049206), ("с", 0.074603), ("сь", 0.074558), ("т", 0.110658), ("у", 0.109070), ("ф", 0.062268), ("х", 0.077188), ("ц", 0.053061), + ("ць", 0.089342), ("ч", 0.057596), ("ш", 0.066077), ("ь", 0.020227), ("і", 0.094150), ("ґ", 0.062948)]) + +-- | A full conversion to the 'Strengths' from a Ukrainian text. +str2Volume :: String -> Strengths +str2Volume = V.map (getBFst' (0.0, V.fromList [("а", 0.890533), ("б", 0.211334), ("в", (-0.630859)), ("г", (-0.757599)), ("д", 0.884613), ("дж", 0.768127), + ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.588959)), ("з", (-0.528870)), ("и", 0.770935), ("й", (-0.708008)), ("к", (-0.443085)), + ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", 0.124908), ("р", 0.647369), ("с", 0.155640), ("сь", (-0.207764)), + ("т", -0.304443), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)), ("ць", 0.381348), ("ч", (-0.189240)), + ("ш", 0.251221), ("ь", 0.495483), ("і", (-0.682709)), ("ґ", 0.557098)])) . convertToProperUkrainian + +-- | A conversion to the 'Double' that is used inside 'str2Volume'. +str2Vol1 :: String -> Double +str2Vol1 = getBFst' (0.0, V.fromList [("а", 0.890533), ("б", 0.211334), ("в", (-0.630859)), ("г", (-0.757599)), ("д", 0.884613), ("дж", 0.768127), + ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.588959)), ("з", (-0.528870)), ("и", 0.770935), ("й", (-0.708008)), ("к", (-0.443085)), + ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", 0.124908), ("р", 0.647369), ("с", 0.155640), ("сь", (-0.207764)), + ("т", -0.304443), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)), ("ць", 0.381348), ("ч", (-0.189240)), + ("ш", 0.251221), ("ь", 0.495483), ("і", (-0.682709)), ("ґ", 0.557098)]) . V.unsafeHead . convertToProperUkrainian + +-- | For the given non-existing 'FilePath' for a sound file supported by SoX generates a silence of the specified duration and quality (see, +-- 'soxBasicParams'). +silentSound2G :: FilePath -> Double -> String -> IO () +silentSound2G file y4 ys = do + _ <- readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ["-r22040","-n",file,"synth", showFFloat (Just 1) y4 "","sine","440.0","vol","0"]) "" + putStr "" + +-- | After producing sounds as WAV or FLAC files you can apply to them volume adjustments using 'Strengths'. The first 'String' is used accordingly to +-- 'soxBasicParams' and the second one -- as a prefix of the filenames for the files that the function is applied to. The files must not be silent ones. +-- Otherwise, it leads to likely noise sounding or errors. +apply6G :: Strengths -> String -> String -> IO () +apply6G v6 ys zs + | V.null v6 = putStrLn "Nothing changed, because the vector of volume adjustments is empty! " + | otherwise = do + dir0v <- listVDirectory3G ys zs + V.imapM_ (\i file -> soxE file ["norm","vol", showFFloat (Just 4) (V.unsafeIndex v6 (i `rem` V.length v6)) ""]) dir0v + +-- | Variant of the 'apply6G' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as a first 'String' argument. +-- It uses 'str2Volume' inside. The files must not be silent ones. Otherwise, it leads to likely noise sounding or errors. +apply6GS :: String -> String -> String -> IO () +apply6GS xs = apply6G (str2Volume xs) + +-- | Variant of the 'apply6G' function which can be applied also to the silent files. Whether a file is silent is defined using the 'Double' argument +-- so that if the maximum by absolute value amplitude is less by absolute value than the 'Double' argument then the file is not changed. +apply6G2 :: Strengths -> String -> String -> Double -> IO () +apply6G2 v6 ys zs limV + | V.null v6 = putStrLn "Nothing changed, because the vector of volume adjustments is empty! " + | otherwise = do + dir0v <- listVDirectory3G ys zs + V.imapM_ (\i file -> apply6GSilentFile file limV (V.unsafeIndex v6 (i `rem` V.length v6))) dir0v + +-- | Variant of the 'apply6G2' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as the first 'String' argument. +-- It uses 'str2Volume' inside. +apply6GS2 :: String -> String -> String -> Double -> IO () +apply6GS2 xs = apply6G2 (str2Volume xs) + diff --git a/DobutokO/Sound/Decibel.hs b/DobutokO/Sound/Decibel.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Decibel.hs @@ -0,0 +1,55 @@ +-- | +-- Module : DobutokO.Sound.Decibel +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Decibel ( + -- * Type synonym with different semantics + StrengthsDb + -- * Working with StrengthsDb and Strengths and others + , dBOmegaRatio + , strength2dB_Abs + , strengthdB2ampl + , strengths2dB + , strengthsDb2ampl +) where + +import qualified Data.Vector as V +import DobutokO.Sound.Functional.Params (Strengths) + +-- | Is used to represent a set of volumes in the dB scale for SoX \"vol\" effect. Usually, the zero value corresponds to the sound with volume +-- level equal by absolute value to 1.0 (the extremum one). So for most cases, its elements are negative numbers not less than (-120). +type StrengthsDb = V.Vector Double + +-- | Returns the frequency for which its ratio with the second 'Double' argument being under lg and being multiplied with 20 returns +-- the first 'Double' argument. For example, @dBOmegaRatio 6 440 ~ 880@ (actually, 877.9154185863069). +dBOmegaRatio :: Double -> Double -> Double +dBOmegaRatio dB omega0 = omega0 * 10 ** (dB / fromIntegral 20) + +-- | Converts the absolute value of the argument to dB value compared to 1.0. Usually, is less than 0. The argument should not be equal to zero (0), +-- otherwise, it is equal to -'Infinity'. +strength2dB_Abs :: Double -> Double +strength2dB_Abs vol = 20 * logBase 10 (abs vol) + +-- | Converts the absolute value of the argument from dB value to amplitude with 0 equivalent to amplitude of 1.0 (or -1.0 for inverted sound). +-- Usually, is used for negative arguments (or at least not positive ones). +strengthdB2ampl :: Double -> Double +strengthdB2ampl dB = 10 ** (dB / fromIntegral 20) + +-- | Converts the 'V.Vector' of the absolute values of the argument to the 'V.Vector' of dB values compared to 1.0. +-- Usually, its elements are less than 0. If some element in the argument is equal to zero (0), the corresponding resulting element is equal to -'Infinity'. +strengths2dB :: Strengths -> StrengthsDb +strengths2dB v = V.map strength2dB_Abs v + +-- | Converts the 'V.Vector' of dB values to the 'V.Vector' of the amplitudes with 0 being equivalent to amplitude of 1.0 (or -1.0 for inverted sound). +-- Usually, is used for negative elements of the first argument (or at least not positive ones). +strengthsDb2ampl :: StrengthsDb -> Strengths +strengthsDb2ampl v = V.map strengthdB2ampl v + diff --git a/DobutokO/Sound/Executable.hs b/DobutokO/Sound/Executable.hs --- a/DobutokO/Sound/Executable.hs +++ b/DobutokO/Sound/Executable.hs @@ -14,7 +14,6 @@ module DobutokO.Sound.Executable ( -- * Basic functions for the executable dobutokO2 - , recAndProcess , dobutokO2H7 , dobutokO2H9 , dobutokO2H92 @@ -25,22 +24,19 @@ import System.Exit (ExitCode (ExitSuccess)) import qualified Data.List as L (groupBy,sort) import CaseBi (getBFst') -import Numeric (showFFloat) import Control.Exception (onException) import System.Environment (getArgs) import Data.List (isPrefixOf) -import Data.Maybe (fromJust,isNothing,fromMaybe) -import Data.Char (isDigit,isSpace) +import Data.Maybe (fromJust,fromMaybe) import System.Process import EndOfExe (showE) -import qualified Data.Vector as V (Vector (..),generate,fromList,length,imapM_,snoc,toList,unsafeSlice,mapM_,imap,unsafeIndex,map,filter,singleton) +import qualified Data.Vector as V (Vector,generate,fromList,length,imapM_,snoc,toList,unsafeSlice,mapM_,unsafeIndex) import System.Directory -import SoXBasics -import Processing_mmsyn7ukr -import DobutokO.Sound hiding (dobutokO2, recAndProcess) +import DobutokO.Sound.Overtones +import DobutokO.Sound.Uniq import DobutokO.Sound.IntermediateF import DobutokO.Sound.ParseList (parseStoLInts) -import DobutokO.Sound.Functional +import DobutokO.Sound.Process -- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end*\" files in the current directory, because they can be overwritten. @@ -385,246 +381,9 @@ putStrLn ys dobutokO2H00 :: Bool -> String -> FilePath -> IO () -dobutokO2H00 exist2 = fadeAllE +dobutokO2H00 _ = fadeAllE {-# INLINE dobutokO2H00 #-} dobutokO2H002 :: Bool -> String -> FilePath -> IO () -dobutokO2H002 exist2 = fadeAllEMilN 2 +dobutokO2H002 _ = fadeAllEMilN 2 {-# INLINE dobutokO2H002 #-} - ----------------------------------------------------------------------------------------------------------------------------------------------------- - --- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing --- whether there is no \"x.wav\" file in the current directory, because it can be overwritten. -recAndProcess :: FilePath -> Int -> IO String -recAndProcess file = - getBFst' (processD, V.fromList [(0,processD0 file),(1,processD1),(2,processD2 file),(3,processD3),(4,processD4),(5,processD5),(7,processD7), - (8,processD8),(9,processD9),(11,processD_1),(99,processD99),(999,processD99)]) - -processD_1 :: IO String -processD_1 = onException (do - putStr "Please, specify two \'Int\' numbers (with intermediate space character between them): the first one is a number of different notes there will be " - putStr "in the result, and the second one is a number of enky, to which you would like all the main components (not taking into account their " - putStr "respective lower bases of the intervals if any will exist) should belong. " - putStrLn "If you specify as the first one 2 (possibly the simplest case), then to the second one you can define a number in the range [3..53]. " - putStrLn "If you specify as the first one 3, then to the second one you can define a number in the range [2..35]. " - putStrLn "If you specify as the first one 4, then to the second one you can define a number in the range [2..26]. " - putStrLn "If you specify as the first one 6, then to the second one you can define a number in the range [1..17]. " - putStrLn "If you specify as the first one 9, then to the second one you can define a number in the range [1..11]. " - enka0 <- getLine - let enka1 = take 2 . words . filter (\x -> isDigit x || isSpace x) $ enka0 - enka2 = read (head . take 1 $ enka1)::Int - enka3 - | enka2 == 2 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 53) 3 == LT then 28 else (read (take 2 . head . tail $ enka1)::Int) - `rem` 53 - | enka2 == 3 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 35) 2 == LT then 19 else (read (take 2 . head . tail $ enka1)::Int) - `rem` 35 - | enka2 == 4 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 26) 2 == LT then 14 else (read (take 2 . head . tail $ enka1)::Int) - `rem` 26 - | enka2 == 6 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 17) 1 == LT then 9 else (read (take 2 . head . tail $ enka1)::Int) - `rem` 17 - | enka2 == 9 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 11) 1 == LT then 6 else (read (take 2 . head . tail $ enka1)::Int) - `rem` 11 - | otherwise = error "Not valid number in the second place. " - return $ show enka2 ++ " " ++ show enka3 ) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD3) -{-# INLINE processD_1 #-} - -processD0 :: FilePath -> IO String -processD0 file = onException (readProcessWithExitCode (fromJust (showE "sox")) [file, "x.wav", "-r22050", "channels", "1"] "" >> putStrLn "" >> return "") (do - exist <- doesFileExist "x.wav" - if exist then removeFile "x.wav" - else putStr "" - putStrLn "" - putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. " - putStrLn "Interrupt the program and start again with the valid file. " - putStrLn "_______________________________________________________________________" - processD0 file) -{-# INLINE processD0 #-} - -processD1 :: IO String -processD1 = onException (do - tempeRa 0 - putStrLn "Please, specify, how many seconds long sound data you would like to record." - time <- getLine - let time0 = read (filter (\t -> isDigit t || t == '.') time)::Double - putStrLn "Please, wait for 0.5 second and produce the needed sound now." - recA "x.wav" time0 - putStrLn "" - return "") (do - dir0 <- listDirectory "." - let paths5 = filter (isPrefixOf "nx.") dir0 - paths6 = filter (== "x.wav") dir0 - paths = paths5 ++ paths6 - mapM_ removeFile paths - putStrLn "" - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD1) -{-# INLINE processD1 #-} - -processD2 :: FilePath -> IO String -processD2 file = onException (do - exist3 <- doesFileExist file - if exist3 then return "" - else do - putStr "Please, specify the control parameter for the SoX \"noisered\" effect in the range from 0.0 to 1.0. " - putStrLn "The greater value causes more reduction with possibly removing some important sound data. The default value is 0.5 " - putStrLn "To use the default value, you can simply press Enter." - ctrlN <- getLine - let addit = dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN - noiseP = if null ctrlN then "" - else tail addit - controlNoiseReduction $ '0':noiseP - norm "_x.wav" - if "nx." `isPrefixOf` file - then putStr "" - else renameFile "8_x.wav" file - removeFile "x.wav" - removeFile "_x.wav" - dir <- listDirectory "." - let paths4 = filter (isPrefixOf "nx.") dir - mapM_ removeFile paths4 - putStrLn "" - return "") (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD2 file) -{-# INLINE processD2 #-} - -processD3 :: IO String -processD3 = onException (do - putStr "Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) " - putStrLn "should belong. The number should be better in the range [1..8]" - fmap d3H getLine) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD3) -{-# INLINE processD3 #-} - -d3H :: String -> String -d3H xs = show $ (read (take 1 xs)::Int) `rem` 9 -{-# INLINE d3H #-} - -processD4 :: IO String -processD4 = onException (do - putStr "Please, specify the amplitude for the generated overtones as an Int number in the range [0..99]. " - putStrLn "The default one is 99" - putStrLn "To use the default value, you can simply press Enter." - fmap d4H getLine) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD4) -{-# INLINE processD4 #-} - -d4H :: String -> String -d4H xs - | null xs = "1.0" - | otherwise = let amplOb = (read (take 2 . filter isDigit $ xs)::Int) `rem` 100 in - case amplOb of - 99 -> "1.0" - _ -> if compare (amplOb `quot` 9) 1 == LT then "0.0" ++ show (amplOb + 1) - else "0." ++ show (amplOb + 1) -{-# INLINE d4H #-} - -processD5 :: IO String -processD5 = onException (do - putStr "Please, specify the basic duration for the generated sounds as a Double number in the range [0.1..4.0]. " - putStrLn "The default one is 0.5" - putStrLn "To use the default value, you can simply press Enter." - fmap d5H getLine) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD5) -{-# INLINE processD5 #-} - -d5H :: String -> String -d5H xs - | null xs = "0.5" - | otherwise = let time1 = (read (filter (\z -> isDigit z || z == '.') xs)::Double) in - if compare time1 0.1 /= LT && compare time1 4.0 /= GT then showFFloat (Just 4) time1 $ show 0 - else let mantissa = time1 - (fromIntegral . truncate $ time1) - ceilP = (truncate time1::Int) `rem` 4 in - if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0) - else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0) -{-# INLINE d5H #-} - -processD7 :: IO String -processD7 = onException (do - putStrLn "Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: " - fmap d7H getLine) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD7) -{-# INLINE processD7 #-} - -d7H :: String -> String -d7H xs - | null xs = "або" - | otherwise = xs -{-# INLINE d7H #-} - -processD8 :: IO String -processD8 = onException (do - putStr "Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. " - putStrLn "The number is in the range [0.1..2.0]. The default one is 1.0" - putStrLn "To use the default value, you can simply press Enter." - fmap d8H getLine) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD8) -{-# INLINE processD8 #-} - -d8H :: String -> String -d8H xs - | null xs = "1.0" - | otherwise = let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') xs)::Double) in - if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then showFFloat (Just 4) dAmpl1 $ show 0 - else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1) - ceilP = (truncate dAmpl1::Int) `rem` 2 in - if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0) - else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0) -{-# INLINE d8H #-} - -processD9 :: IO String -processD9 = onException (do - putStrLn "Please, input the Ukrainian text that will be used to define the intervals to be used to produce the lower note for the given main one. " - putStrLn "The default one is \"й\". " - putStrLn "To use the default value, you can simply press Enter." - fmap d9H getLine) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD9) -{-# INLINE processD9 #-} - -d9H :: String -> String -d9H xs - | null xs = "й" - | otherwise = xs -{-# INLINE d9H #-} - -processD :: IO String -processD = onException (do - putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: " - getLine) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD) -{-# INLINE processD #-} - -processD99 :: IO String -processD99 = onException (do - putStr "Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indices for the files to be played " - putStr "with SoX effects applied to. The lists must be separated with newline (just press \"Enter\"), empty lists are ignored. If index is an " - putStrLn "element of several input lists then if its number of occurrences in all the lists is odd, then it is played, otherwise it is not. " - putStrLn "To end the input, just press the combination that means the end of input (e. g. for Unices, it's probably Ctrl + D). " - getContents) (do - putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." - putStrLn "_______________________________________________________________________" - processD) -{-# INLINE processD99 #-} - ----------------------------------------------------------------------------------------------- - diff --git a/DobutokO/Sound/Extended.hs b/DobutokO/Sound/Extended.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Extended.hs @@ -0,0 +1,64 @@ +-- | +-- Module : DobutokO.Sound.Extended +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Extended ( + -- * Even more extended + dviykyTA + , triykyTA + , chetvirkyTA + , p'yatirkyTA + , shistkyTA + , simkyTA + , visimkyTA + , dev'yatkyTA + , desyatkyTA + , odynadtsyatkyTA + , octavesTA +) where + +import qualified Data.Vector as V +import DobutokO.Sound.Functional.Basics (NotePairs,notes) + +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))) + +-------------------------------------------------------------------------------------------------------------------------- diff --git a/DobutokO/Sound/FunctionF.hs b/DobutokO/Sound/FunctionF.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/FunctionF.hs @@ -0,0 +1,81 @@ +-- | +-- Module : DobutokO.Sound.FunctionF +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.FunctionF ( + -- * Working with OvertonesO and function f + maybeFFromStrVec + , fVecCoefs + , showFFromStrVec +) where + +import Text.Read (readMaybe) +import Data.Maybe (isNothing,fromJust,fromMaybe) +import Numeric +import qualified Data.Vector as V +import DobutokO.Sound.Functional.Basics + +-- | Gets a function @f::Double -> OvertonesO@ that can be used further. Has two variants with usage of 'closestNote' ('Int' argument is greater than 0)v +-- and without it ('Int' argument is less than 0). For both cases 'String' must be in a form list of tuples of pairs of 'Double' to get somewhat +-- reasonable result. The function @f@ can be shown using a special printing function 'showFFromStrVec'. It is a simplest multiplicative (somewhat +-- acoustically and musically reasonable) form for the function that can provide such a result that fits into the given data. +-- +-- > let (y,f1) = fromJust (maybeFFromStrVec 1 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783) +-- > +-- > (3520.0,[(25.829079975681818,0.2486356),(37.936206670369316,0.6464867),(494.9891484317899,0.374618646),(803.9138234326421,0.463486461)]) +-- > +-- > let (y,f1) = fromJust (maybeFFromStrVec (-1) 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783) +-- > +-- > (3583.9783,[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]) +-- +maybeFFromStrVec :: Int -> Double -> String -> Maybe (Double,(Double -> V.Vector (Double,Double))) +maybeFFromStrVec n x ys + | n == 0 || null ys = Nothing + | n > 0 = + let y = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + v = readMaybe ys::Maybe (V.Vector (Double,Double)) + v2 = fromMaybe V.empty v + v3 = V.map (\(t,_) -> t / y) v2 in + if V.null v3 then Nothing + else Just (y,(\t1 -> V.imap (\i (_,ampl2) -> ((V.unsafeIndex v3 i) * t1,ampl2)) v2)) + | otherwise = + let y = (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + v = readMaybe ys::Maybe (V.Vector (Double,Double)) + v2 = fromMaybe V.empty v + v3 = V.map (\(t,_) -> t / y) v2 in + if V.null v3 then Nothing + else Just (y,(\t1 -> V.imap (\i (_,ampl2) -> ((V.unsafeIndex v3 i) * t1,ampl2)) v2)) + +-- | Gets multiplication coefficients for @f::Double -> Vector (Double,Double)@ from the 'maybeFFromStrVec' with the same arguments. +fVecCoefs :: Int -> Double -> String -> V.Vector Double +fVecCoefs n x ys = + let rs = maybeFFromStrVec n x ys in + case rs of + Nothing -> V.empty + _ -> + let (_,f1) = fromJust rs in + V.map fst (f1 1) + +-- | Experimental 'show' for @f::Double -> Vector (Double,Double)@ that is used only for visualisation. It is correct only with 'maybeFFromStrVec' or +-- equivalent function. Because the shape of the @f@ is known the function can be defined. +-- +-- > showFFromStrVec (-1) 440 "[(25.358,0.3598),(489.35,0.4588962),(795.35,0.6853)]" +-- > +-- > "(440.00,(\t -> <(0.05763181818181818 * t, 0.3598),(1.112159090909091 * t, 0.4588962),(1.8076136363636364 * t, 0.6853)>))" +-- +showFFromStrVec :: Int -> Double -> String -> String +showFFromStrVec n x ys + | isNothing . maybeFFromStrVec n x $ ys = "" + | otherwise = + let (y,f) = fromJust . maybeFFromStrVec n x $ ys + l = length ("(" ++ (showFFloat Nothing y "") ++ ",(\t -> <(" ++ concat (V.toList . V.map (\z -> (showFFloat Nothing (fst z) $ + " * t, " ++ (showFFloat Nothing (snd z) "),("))) $ (f 1))) in take (l - 2) ("(" ++ (showFFloat Nothing y "") ++ ",(\t -> <(" + ++ concat (V.toList . V.map (\z -> (showFFloat Nothing (fst z) " * t, " ++ (showFFloat Nothing (snd z) "),("))) $ (f 1))) ++ ">))" diff --git a/DobutokO/Sound/Functional.hs b/DobutokO/Sound/Functional.hs --- a/DobutokO/Sound/Functional.hs +++ b/DobutokO/Sound/Functional.hs @@ -12,2430 +12,629 @@ {-# OPTIONS_GHC -threaded #-} module DobutokO.Sound.Functional ( - Params (..) - -- * Type synonyms with different semantics - , SoundsO - , OvertonesO - , NotePairs - , Durations - , Strengths - , StrengthsDb - , Intervals - -- * Work with notes (general) - , notes - , neighbourNotes - , closestNote - , pureQuintNote - , overTones - -- * Work with enky (extension to octaves functionality) - , nkyT - , whichOctave - , whichOctaveG - , whichEnka - , enkuUp - , enkuDown - , liftInEnkuV - , liftInEnku - -- ** Work with octaves - , octavesT - -- * Combining intermediate files - , mixTest - , mixTest2 - -- * Working with files - , freqsFromFile - , endFromResult - -- * Work with overtones - , overSoXSynth - -- * Use additional function as a parameter - , overSoXSynth2FDN - , overSoXSynth2FDN_B - -- ** Just simple function application - , overSoXSynth2FDN_S - -- *** With additional filtering - , overSoXSynth2FDN_Sf - , overSoXSynth2FDN_Sf3 - -- * Use additional function and Ukrainian texts and generates melody - , overSoXSynthGen2FDN - , overSoXSynthGen2FDN_B - , overSoXSynthGen2FDN_S - , overSoXSynthGen2FDN_Sf - , overSoXSynthGen2FDN_Sf3 - , dNote - -- * 1G generalized functions with dB volume overtones adjustments - , overSoXSynth2FDN1G - , overSoXSynth2FDN_B1G - , overSoXSynth2FDN_S1G - , overSoXSynth2FDN_Sf1G - , overSoXSynth2FDN_Sf31G - , partialTest_k1G - -- * 2G generalized functions with additional sound quality specifying - , overSoXSynth2FDN2G - , overSoXSynth2FDN_B2G - , overSoXSynth2FDN_S2G - , overSoXSynth2FDN_Sf2G - , overSoXSynth2FDN_Sf32G - , partialTest_k2G - , soundGenF32G - -- ** 2G generalized functions for melody producing - , overSoXSynthGen2FDN_SG2G - , overSoXSynthGen2FDN_Sf3G2G - -- ** 2G generalized auxiliary functions - , mixTest2G - , mixTest22G - , endFromResult2G - -- * Generalized functions with several functional parameters - , soundGenF3 - , overSoXSynthGen2FDN_SG - , overSoXSynthGen2FDN_Sf3G - -- ** 1G generalized function with db volume overtones adjustments and several functional parameters - , soundGenF31G - -- ** Auxiliary functions - , adjust_dbVol - , partialTest_k - , prependZeroes - , nOfZeroesLog - , numVZeroesPre - , syllableStr - , helpF1 - , helpF0 - , doubleVecFromVecOfDouble - -- *** Working with Intervals - , intervalsFromString - , vStrToVInt - , strToInt - -- * Working with OvertonesO and function f - , maybeFFromStrVec - , fVecCoefs - , showFFromStrVec - -- * Functions to edit OvertonesO and function f (since 0.25.0.0) - , renormF - , renormFD - , sameOvertone - , sameOvertoneL - , sameFreqF - , sameFreqFI - , fAddFElem - , fRemoveFElem - , fChangeFElem - , gAdd01 - , gAdd02 - , gAdd03 - , gAdd04 - , gRem01 - , gRem02 - , gRem03 - -- ** Working with two OvertonesO - , fAddFElems - , fRemoveFElems - , fChangeFElems - , freqsOverlapOvers - , elemsOverlapOvers - , gAdds01 - , gAdds02 - -- * Splitting and concatenating OvertonesO - , splitO - , splitO2 - , overConcat - -- ** Generalization of the previous ones splitting functions - , splitHelp1 - , splitHelp2 - , splitOG1 - , splitOG2 - , splitOG12 - , splitOG12S - , splitOG22 - , splitOG22S - -- * New functions for the version 0.36.0.0 - , duration1000 - , durationsAver - , str2Durat1 - , str2Durations - , str2DurationsDef - , str2Vol1 - , str2Volume - , defInt - , doublesAveragedA - , doublesAveragedG - , equalize2Vec - , intervalsFromStringG - , overSoXSynthGen2FDN4G - , overSoXSynthGen2FDN_SG4G - , overSoXSynthGen2FDN_SG4GS - , silentSound2G - , strToIntG - , strengthsAver - , strengthsDbAver - , vStrToVIntG - -- * New generalized 5G functions that works with Intervals - , overSoXSynth2FDN5G - , overSoXSynth2FDN_B5G - , overSoXSynth2FDN_S5G - , overSoXSynth2FDN_Sf35G - -- * New generalized 6G functions that works with Strengths - , apply6Gf - , apply6G - , apply6G2 - , apply6GS - , apply6GS2 - , apply6GSilentFile - , overSoXSynth2FDN6G - , overSoXSynth2FDN6GS - , overSoXSynth2FDN_B6G - , overSoXSynth2FDN_B6GS - , overSoXSynth2FDN_S6G - , overSoXSynth2FDN_S6GS - , overSoXSynth2FDN_Sf36G - , overSoXSynth2FDN_Sf36GS - , overSoXSynthGen2FDN_SG6G - , overSoXSynthGen2FDN_SG6GS - , overSoXSynthGen2FDN_SG6GSu - -- * Working with StrengthsDb and Strengths and others - , dBOmegaRatio - , strength2dB_Abs - , strengthdB2ampl - , strengths2dB - , strengthsDb2ampl - -- * New generalizations for scales and modes with Params - , filterInParams - , sortNoDup - , toneD - , toneE - , liftInParams - , liftInParamsV - , lengthP - , elemP - , elemCloseP - , showD - , isStrParams - , isListParams - -- ** Application of the Params - , overSoXSynthGen2FDN_SG4GPar - , overSoXSynthGen2FDN_SG6GPar - , overSoXSynthGen2FDN_SG2GPar - , overSoXSynthGen2FDN_SfPar - , overSoXSynthGen2FDN_Sf3GPar - , overSoXSynthGen2FDN_Sf3G2GPar - -- * Another way to generalize the simple functions - , testSoundGen2G - , soundGen3G - , soundGen3G_O - , soundGen3G_O2 - , soundGen3G_O2G - -- ** With MN control - , testSoundGen2GMN - , soundGen3GMN - , soundGen3G_OMN - , soundGen3G_O2MN - , soundGen3G_O2GMN - , h1 - , h2 - -- ** New with Params control - , soundGen3G_OPar - , soundGen3G_O2Par - , soundGen3G_O2GPar - , soundGen3G_OMNPar - , soundGen3G_O2MNPar - , soundGen3G_O2GMNPar - , h2Params - -- * Creating melody from overtones - , overMeloPar -) where - -import Text.Read (readMaybe) -import CaseBi (getBFst') -import Data.Char (isDigit,isAsciiLower) -import System.Exit (ExitCode( ExitSuccess )) -import Numeric -import Data.List (isPrefixOf,sort,sortBy,nubBy) -import Data.Maybe (isNothing,fromJust,isJust,fromMaybe,maybe) -import qualified Data.Vector as V -import System.Process -import EndOfExe -import System.Directory -import Melodics.Ukrainian (convertToProperUkrainian) -import SoXBasics (durationA,upperBnd,selMaxAbs) -import MMSyn7l -import MMSyn7.Syllable -import DobutokO.Sound.IntermediateF -import GHC.Int (Int64) -import DobutokO.Sound.Keyboard - - --- | Representation of the scales and modes for the notes. Can be extended further, but for a lot of situations the following realization is sufficient. --- See, for example, 'filterInParams' and so on. 'String' is (are) used as a general classification name, for some of them there are provided two --- 'String' to classify. Lists are used to specify remainders in some meaning. See also, 'liftInParams' and 'toneE' ('toneD') functions, 'elemP' and --- 'elemCloseP', 'lengthP' and 'showD'. -data Params = P2 Int Int | P2s Int Int String | P3sf Int Int Int String | P4lsf Int Int Int [Int] String | P32sf Int Int Int String String - | P3lf Int Int [Int] deriving (Eq, Ord, Show) - --- | Is used to represent a sequence of intervals, each note being a 'Double' value (its frequency in Hz). -type SoundsO = V.Vector (Double, Double) - --- | Is used to represent a set of overtones for the single sound, the first 'Double' value is a frequency and the second one -- an amplitude. -type OvertonesO = V.Vector (Double, Double) - --- | Is used to represent a set of pairs of notes for each element of which the 'Double' values (notes frequencies in Hz) are somewhat --- musically connected one with another.. -type NotePairs = V.Vector (Double, Double) - --- | Is used to represent a set of durations parameters of the sounds and pauses. The positive value corresponds to the sound --- and the negative one -- to the pause. -type Durations = V.Vector Double - --- | Is used to represent a set of volumes in the amplitude scale for SoX \"vol\" effect. -type Strengths = V.Vector Double - --- | Is used to represent a set of volumes in the dB scale for SoX \"vol\" effect. Usually, the zero value corresponds to the sound with volume --- level equal by absolute value to 1.0 (the extremum one). So for most cases, its elements are negative numbers not less than (-120). -type StrengthsDb = V.Vector Double - --- | Is used to represent a set of intervals for notes (each element is a number of semi-tones between parts of interval). --- Positive values corresponds to lower notes and negative to higher ones. -type Intervals = V.Vector Int - --- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with --- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is an experimental feature, so --- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the --- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. 'Int' argument is an index of the element to be taken from --- the 'intervalsFromString' applied to the 'String' argument. To obtain compatible with versions prior to 0.20.0.0 behaviour, use for the 'Int' 0. --- --- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. --- But for a lot of functions this works well. --- --- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN'. -overSoXSynth2FDN :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO () -overSoXSynth2FDN f (x, y) j zs = overSoXSynth2FDN1G f (x, y) j zs (V.replicate (V.length . f . closestNote $ if x /= 0.0 - then abs x else V.unsafeIndex notes 0) 0.0) - --- | Is used internally in the 'readProcessWithExitCode' to adjust volume for the sound with additional dB value given by 'Double' argument. -adjust_dbVol :: [String] -> Double -> [String] -adjust_dbVol xss y - | y == 0.0 = xss - | otherwise = xss ++ ["vol",showFFloat Nothing y "dB"] - --- | Returns the frequency for which its ratio with the second 'Double' argument being under lg and being multiplied with 20 returns --- the first 'Double' argument. For example, @dBOmegaRatio 6 440 ~ 880@ (actually, 877.9154185863069). -dBOmegaRatio :: Double -> Double -> Double -dBOmegaRatio dB omega0 = omega0 * 10 ** (dB / fromIntegral 20) - --- | Converts the absolute value of the argument to dB value compared to 1.0. Usually, is less than 0. The argument should not be equal to zero (0), --- otherwise, it is equal to -'Infinity'. -strength2dB_Abs :: Double -> Double -strength2dB_Abs vol = 20 * logBase 10 (abs vol) - --- | Converts the absolute value of the argument from dB value to amplitude with 0 equivalent to amplitude of 1.0 (or -1.0 for inverted sound). --- Usually, is used for negative arguments (or at least not positive ones). -strengthdB2ampl :: Double -> Double -strengthdB2ampl dB = 10 ** (dB / fromIntegral 20) - --- | Converts the 'V.Vector' of the absolute values of the argument to the 'V.Vector' of dB values compared to 1.0. --- Usually, its elements are less than 0. If some element in the argument is equal to zero (0), the corresponding resulting element is equal to -'Infinity'. -strengths2dB :: Strengths -> StrengthsDb -strengths2dB v = V.map strength2dB_Abs v - --- | Converts the 'V.Vector' of dB values to the 'V.Vector' of the amplitudes with 0 being equivalent to amplitude of 1.0 (or -1.0 for inverted sound). --- Usually, is used for negative elements of the first argument (or at least not positive ones). -strengthsDb2ampl :: StrengthsDb -> Strengths -strengthsDb2ampl v = V.map strengthdB2ampl v - --- | 'V.Vector' of 'Double' is a vector of dB volume adjustments for the corresponding harmonices (overtones). -overSoXSynth2FDN1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () -overSoXSynth2FDN1G f (x, y) j zs vdB = overSoXSynth2FDN2G f (x, y) j zs vdB [] - --- | Similar to 'overSoXSynth2FDN1G', but additionally allows to specify by the second 'String' argument a quality changes to the generated files --- (please, see 'soxBasicParams'). Since version 0.36.0.0 the function supports generation of the pauses. -overSoXSynth2FDN2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () -overSoXSynth2FDN2G f (x, y) j zs vdB ys - | V.null . convertToProperUkrainian $ zs = overSoXSynth x - | otherwise = do - let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - l0 = length zs - note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 - g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) -> - if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, - abs (amplX - (fromIntegral . truncate $ amplX)))) . f - g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k - v0 = g note0 - v1 = maybe V.empty g note1 - ts = showFFloat (Just 4) (abs y) "" - overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") - overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "","vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"] (V.unsafeIndex vdB i))) "") vec - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts, - "sine", showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then overSoXSynthHelp v0 - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts, - "sine", showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - overSoXSynthHelp v0 - overSoXSynthHelp2 v1 vdB - if null ys then mixTest else mixTest2G ys - --- | Similar to 'overSoXSynth2FDN2G', but additionally allows to specify by the 'Intervals' argument to specify your own intervals. For more information, --- please, refer to 'intervalsFromStringG'. -overSoXSynth2FDN5G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () -overSoXSynth2FDN5G f (x, y) j v5 vdB ys - | V.null v5 = overSoXSynth x - | otherwise = do - let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - l0 = V.length v5 - note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 - g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) -> - if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, - abs (amplX - (fromIntegral . truncate $ amplX)))) . f - g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k - v0 = g note0 - v1 = maybe V.empty g note1 - ts = showFFloat (Just 4) (abs y) "" - overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") - overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "","vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"] (V.unsafeIndex vdB i))) "") vec - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts, - "sine", showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then overSoXSynthHelp v0 - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts, - "sine", showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - overSoXSynthHelp v0 - overSoXSynthHelp2 v1 vdB - if null ys then mixTest else mixTest2G ys - --- | Generalized variant of the 'overSoXSynth2FDN5G' with afterwards 'apply6Gf' usage. -overSoXSynth2FDN6G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () -overSoXSynth2FDN6G f (x, y) j v5 vdB ys vol - | V.null v5 = overSoXSynth x - | otherwise = do - let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - l0 = V.length v5 - note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 - g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) -> - if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, - abs (amplX - (fromIntegral . truncate $ amplX)))) . f - g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k - v0 = g note0 - v1 = maybe V.empty g note1 - ts = showFFloat (Just 4) (abs y) "" - overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") - overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "","vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"] (V.unsafeIndex vdB i))) "") vec - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts, - "sine", showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then overSoXSynthHelp v0 - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts, - "sine", showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - overSoXSynthHelp v0 - overSoXSynthHelp2 v1 vdB - if null ys then mixTest else mixTest2G ys - if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" - --- | A variant of the 'overSoXSynth2FDN6G' where volume adjustment is obtained from a Ukrainian text. -overSoXSynth2FDN6GS :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () -overSoXSynth2FDN6GS f (x, y) j v5 xs vdB ys xxs - | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " - | otherwise = overSoXSynth2FDN6G f (x, y) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) - --- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set --- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12. --- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. A 'Double' parameter is a --- basic sound duration, it defines tempo of the melody in general. -overSoXSynthGen2FDN :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () -overSoXSynthGen2FDN file m ku f y zs wws = overSoXSynthGen2FDN_SG file m ku f y zs wws overSoXSynth2FDN - --- | Generalized variant of the 'overSoXSynthGen2FDN' with your own specified 'Durations' for the sounds and pauses. --- Instead of using a Ukrainian text to specify a durations for the sounds (and a rhythm --- respectively) you provide your own rhythm as 'Durations'. Positive values correspond to durations of the sounds generated --- and negative values -- to durations of the pauses respectively. -overSoXSynthGen2FDN4G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Durations -> String -> IO () -overSoXSynthGen2FDN4G file m ku f y v2 wws = overSoXSynthGen2FDN_SG4G file m ku f y v2 wws overSoXSynth2FDN - --- | Gets 'V.Vector' of 'Int' frequencies from the given 'FilePath' using SoX. The frequencies are \"rough\" according to the SoX documentation and --- the duration is too small so they can be definitely other than expected ones. Is used as a source of variable numbers (somewhat close each to another --- in their order but not neccessarily). . -freqsFromFile :: FilePath -> Int -> IO (V.Vector Int) -freqsFromFile file n = V.generateM n (\k -> do { - (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat Nothing (fromIntegral k * 0.001) "", - "0.001", "stat"] "" - ; let line0s = lines herr - noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s - ; if null noteN0 then return (11440::Int) - else let noteN1 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) - --- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work --- on them properly. Afterwards, the function deletes these combined files. -mixTest :: IO () -mixTest = do - paths0 <- listDirectory "." - let paths = filter (isPrefixOf "test") $ paths0 - _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" - mapM_ removeFile paths - --- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to --- 'soxBasicParams'. -mixTest2G :: String -> IO () -mixTest2G ys = do - paths0 <- listDirectory "." - let paths = filter (isPrefixOf "test") $ paths0 - _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result.wav","vol","0.3"]) "" - mapM_ removeFile paths - --- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work --- on them properly. Afterwards, the function deletes these combined files. The name of the resulting file depends on the first two command line --- arguments so that it is easy to produce unique names for the consequent call for the function. -mixTest2 :: Int -> Int -> IO () -mixTest2 zeroN j = do - paths0 <- listDirectory "." - let paths = filter (isPrefixOf "test") $ paths0 - _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav", - "vol","0.3"]) "" - mapM_ removeFile paths - --- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to --- 'soxBasicParams'. The name of the resulting file depends on the first two command line --- arguments so that it is easy to produce unique names for the consequent call for the function. -mixTest22G :: Int -> Int -> String -> IO () -mixTest22G zeroN j ys = do - paths0 <- listDirectory "." - let paths = filter (isPrefixOf "test") $ paths0 - _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result" ++ prependZeroes zeroN (show j) ++ - ".wav","vol","0.3"]) "" - mapM_ removeFile paths - --- | Gets an \"end.wav\" file from the intermediate \"result\*.wav\" files in the current directory. If it is not successful, produces the notification --- message and exits without error. If you would like to create the file if there are too many intermediate ones, please, run --- \"dobutokO2 8\" or \"dobutokO2 80\" in the current directory. -endFromResult :: IO () -endFromResult = do - path2s <- listDirectory "." - let paths3 = sort . filter (isPrefixOf "result") $ path2s - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" - case code of - ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " - _ -> do - exi <- doesFileExist "end.wav" - if exi then removeFile "end.wav" - else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >> - putStrLn "Use them manually as needed." - --- | Similar to 'endFromResult', but uses additional 'String' argument to change sound quality parameters. For more information, please, refer to --- 'soxBasicParams'. -endFromResult2G :: String -> IO () -endFromResult2G ys = do - path2s <- listDirectory "." - let paths3 = sort . filter (isPrefixOf "result") $ path2s - (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ soxBasicParams ys ["","end.wav"]) "" - case code of - ExitSuccess -> putStrLn $ "The final file \"end." ++ if drop 3 ys == "f" then "flac" else "wav" ++ "\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " - _ -> do - exi <- doesFileExist $ "end." ++ if drop 3 ys == "f" then "flac" else "wav" - if exi then removeFile $ "end." ++ if drop 3 ys == "f" then "flac" else "wav" - else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >> - putStrLn "Use them manually as needed." - --- | Creates part of the needed \"test\*\.wav" files in the current directory. -partialTest_k :: OvertonesO -> Int -> String -> IO () -partialTest_k vec k ts = partialTest_k2G vec k ts V.empty [] - --- | Generalized version of the 'partialTest_k' with the additional volume adjustment in dB given by 'V.Vector' of 'Double'. -partialTest_k1G :: OvertonesO -> Int -> String -> V.Vector Double -> IO () -partialTest_k1G vec k ts vdB = partialTest_k2G vec k ts vdB [] - --- | Generalized version of the 'partialTest_k1G' with a possibility to change sound quality parameters using the additional second 'String' argument. --- For more information, please, refer to 'soxBasicParams'. -partialTest_k2G :: OvertonesO -> Int -> String -> V.Vector Double -> String -> IO () -partialTest_k2G vec k ts vdB ys = - let l = V.length vec - zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 50 == 0 - then do - _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", - "synth", ts,"sine", showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""] - (V.unsafeIndex vdB i))) "" - path1s <- listDirectory "." - let path2s = sort . filter (isPrefixOf $ "test" ++ show k) $ path1s - (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ soxBasicParams ys ["","test-" ++ show k ++ - prependZeroes zeroN (show (i `quot` 50)) ++ ".wav"]) "" - case code of - ExitSuccess -> mapM_ removeFile path2s - _ -> do - exi <- doesFileExist $ "test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav" - if exi then putStrLn (herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav") - else putStrLn herr0 - else readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id - else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", - "synth", ts,"sine", showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""])) "" >> putStr "") vec - --- | Generates a 'V.Vector' of 'OvertonesO' that represents the sound. -doubleVecFromVecOfDouble :: (Double -> OvertonesO) -> Double -> V.Vector (Maybe Double) -> V.Vector OvertonesO -doubleVecFromVecOfDouble f t0 = - V.map (\note1 -> if isNothing note1 then V.empty else V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f . fromJust $ note1) - --- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with --- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is experimental feature, so --- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the --- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. The function also tries to perform filtering to avoid possible beating. --- The third 'Double' parameter in the tuple is used as a limit for frequencies difference in Hz to be filtered out from the resulting sound. It is --- considered to be from the range @[0.1..10.0]@. An 'Int' parameter is used to define the needed interval. To obtain compatible with versions prior --- to 0.20.0.0 behaviour, use for the 'Int' 0. --- --- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. --- But for a lot of functions this works well. --- --- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_B'. -overSoXSynth2FDN_B :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO () -overSoXSynth2FDN_B f (x, y, limB) j zs = overSoXSynth2FDN_B1G f (x, y, limB) j zs (V.replicate (V.length . f . closestNote $ if x /= 0.0 then abs x else V.unsafeIndex notes 0) 0.0) - --- | 'V.Vector' of 'Double' is a vector of dB volume adjustments for the corresponding harmonices (overtones). -overSoXSynth2FDN_B1G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> IO () -overSoXSynth2FDN_B1G f (x, y, limB) j zs vdB = overSoXSynth2FDN_B2G f (x, y, limB) j zs vdB [] - --- | Generalized version of the 'overSoXSynth2FDN_B1G' with a possibility to specify sound quality parameters using additional second 'String' --- argument. For more information, please, refer to 'soxBasicParams'. -overSoXSynth2FDN_B2G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () -overSoXSynth2FDN_B2G f (x, y, limB) j zs vdB ys - | V.null . convertToProperUkrainian $ zs = overSoXSynth x - | otherwise = do - let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10 - limA = if compare limA0 0.1 == LT then 0.1 else limA0 - l0 = length zs - note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 - g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) -> - if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, - abs (amplX - (fromIntegral . truncate $ amplX)))) . f - v0 = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 note0) $ 0), z0)) . g0 $ note0 - v1 = if isNothing note1 then V.empty - else V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 . fromJust $ note1) $ 0), z0)) . g0 . fromJust $ note1 - ts = showFFloat (Just 4) (abs y) "" - overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") - overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) - ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "", "vol", - if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"])) "") vec - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", - showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then overSoXSynthHelp v0 - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", - showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - overSoXSynthHelp v0 - overSoXSynthHelp2 v1 vdB - if null ys then mixTest else mixTest2G ys - --- | Generalized version of the 'overSoXSynth2FDN_B2G' with a possibility to specify your own 'Intervals'. For more information, please, --- refer to 'intervalsFromStringG'. -overSoXSynth2FDN_B5G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () -overSoXSynth2FDN_B5G f (x, y, limB) j v5 vdB ys - | V.null v5 = overSoXSynth x - | otherwise = do - let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10 - limA = if compare limA0 0.1 == LT then 0.1 else limA0 - l0 = V.length v5 - note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 - g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) -> - if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, - abs (amplX - (fromIntegral . truncate $ amplX)))) . f - v0 = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 note0) $ 0), z0)) . g0 $ note0 - v1 = if isNothing note1 then V.empty - else V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 . fromJust $ note1) $ 0), z0)) . g0 . fromJust $ note1 - ts = showFFloat (Just 4) (abs y) "" - overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") - overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) - ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "", "vol", - if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"])) "") vec - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", - showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then overSoXSynthHelp v0 - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", - showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - overSoXSynthHelp v0 - overSoXSynthHelp2 v1 vdB - if null ys then mixTest else mixTest2G ys - --- | Generalized variant of the 'overSoXSynth2FDN_B5G' with afterwards 'apply6G' usage. -overSoXSynth2FDN_B6G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () -overSoXSynth2FDN_B6G f (x, y, limB) j v5 vdB ys vol - | V.null v5 = overSoXSynth x - | otherwise = do - let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10 - limA = if compare limA0 0.1 == LT then 0.1 else limA0 - l0 = V.length v5 - note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 - g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) -> - if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, - abs (amplX - (fromIntegral . truncate $ amplX)))) . f - v0 = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 note0) $ 0), z0)) . g0 $ note0 - v1 = if isNothing note1 then V.empty - else V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . - V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 . fromJust $ note1) $ 0), z0)) . g0 . fromJust $ note1 - ts = showFFloat (Just 4) (abs y) "" - overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", - showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") - overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) - ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "", "vol", - if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"])) "") vec - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", - showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then overSoXSynthHelp v0 - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", - showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - overSoXSynthHelp v0 - overSoXSynthHelp2 v1 vdB - if null ys then mixTest else mixTest2G ys - if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" - --- | A variant of the 'overSoXSynth2FDN_B6G' where volume adjustment is obtained from a Ukrainian text. -overSoXSynth2FDN_B6GS :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () -overSoXSynth2FDN_B6GS f (x, y, limB) j v5 xs vdB ys xxs - | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " - | otherwise = overSoXSynth2FDN_B6G f (x, y, limB) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) - --- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set --- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12. --- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. The first 'Double' parameter is a --- basic sound duration, it defines tempo of the melody in general. The second one is a limit for frequencies difference in Hz to be filtered out from the --- resulting sound. It is considered to be from the range @[0.1..10.0]@. -overSoXSynthGen2FDN_B :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> IO () -overSoXSynthGen2FDN_B file m ku f y limB zs wws = overSoXSynthGen2FDN_Sf3G file m ku f y limB zs wws overSoXSynth2FDN_B - --- | Similar to 'overSoXSynth2FDN' but it does not make any normalizing transformations with the 'V.Vector' argument. To be used properly, it is needed --- that every second element in the tuple in the 'V.Vector' argument must be in the range [-1.0..1.0] and every first element must be in between --- 16.351597831287414 and 7902.132820097988 (Hz). An 'Int' parameter is used to define an interval. To obtain compatible with versions prior to --- 0.20.0.0 behaviour, use for the 'Int' 0. --- --- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. --- But for a lot of functions this works well. --- --- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_S'. -overSoXSynth2FDN_S :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO () -overSoXSynth2FDN_S f (x, y) j zs = overSoXSynth2FDN_S2G f (x, y) j zs V.empty [] - --- | Generalized version of the 'overSoXSynth2FDN_S' with the additional volume adjustment in dB for overtones given by 'V.Vector' of 'Double'. -overSoXSynth2FDN_S1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () -overSoXSynth2FDN_S1G f (x, y) j zs vdB = overSoXSynth2FDN_S2G f (x, y) j zs vdB [] - --- | Generalized version of the 'overSoXSynth2FDN_S1G' with a possibility to specify sound quality parameters using the second 'String' argument. --- For more information, please, refer to 'soxBasicParams'. -overSoXSynth2FDN_S2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () -overSoXSynth2FDN_S2G f (x, y) j zs vdB ys - | V.null . convertToProperUkrainian $ zs = overSoXSynth x - | otherwise = do - let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - l0 = length zs - note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 - v0 = f note0 - v1 = maybe V.empty f note1 - ts = showFFloat (Just 4) (abs y) "" - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", - showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then partialTest_k2G v0 0 ts vdB ys - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", - showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - partialTest_k2G v0 0 ts vdB ys - partialTest_k2G v1 1 ts vdB ys - if null ys then mixTest else mixTest2G ys - --- | Generalized version of the 'overSoXSynth2FDN_S2G' where you specify your own 'Intervals'. For more information, please, refer --- to 'intervalsFromStringG'. -overSoXSynth2FDN_S5G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () -overSoXSynth2FDN_S5G f (x, y) j v5 vdB ys - | V.null v5 = overSoXSynth x - | otherwise = do - let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - l0 = V.length v5 - note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 - v0 = f note0 - v1 = maybe V.empty f note1 - ts = showFFloat (Just 4) (abs y) "" - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", - showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then partialTest_k2G v0 0 ts vdB ys - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", - showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - partialTest_k2G v0 0 ts vdB ys - partialTest_k2G v1 1 ts vdB ys - if null ys then mixTest else mixTest2G ys - --- | Generalized variant of the 'overSoXSynth2FDN_S5G' with afterwards 'apply6G' usage. Arguments for the latter is the three last function arguments. -overSoXSynth2FDN_S6G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () -overSoXSynth2FDN_S6G f (x, y) j v5 vdB ys vol - | V.null v5 = overSoXSynth x - | otherwise = do - let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - l0 = V.length v5 - note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 - v0 = f note0 - v1 = maybe V.empty f note1 - ts = showFFloat (Just 4) (abs y) "" - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", - showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - if isNothing note1 then partialTest_k2G v0 0 ts vdB ys - else do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", - showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" - partialTest_k2G v0 0 ts vdB ys - partialTest_k2G v1 1 ts vdB ys - if null ys then mixTest else mixTest2G ys - if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" - --- | A variant of the 'overSoXSynth2FDN_S6G' where volume adjustment is obtained from a Ukrainian text. -overSoXSynth2FDN_S6GS :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () -overSoXSynth2FDN_S6GS f (x, y) j v5 xs vdB ys xxs - | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " - | otherwise = overSoXSynth2FDN_S6G f (x, y) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) - --- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. Note that the first '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@. -overSoXSynthGen2FDN_SG :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () -overSoXSynthGen2FDN_SG file m ku f y zs wws h = do - n <- duration1000 file - overSoXSynthGen2FDN_SG4G file m ku f y (str2DurationsDef n zs y) wws h - --- | Generalized version of the 'overSoXSynthGen2FDN_SG' where instead of using a Ukrainian text to specify a durations for the sounds (and a rhythm --- respectively) you provide your own rhythm as 'Durations'. Positive values correspond to durations of the sounds generated --- and negative values -- to durations of the pauses respectively. Please, use a function @h :: ((Double -> OvertonesO) -> (Double, Double) -> --- Int -> String -> IO ())@ such that it can create for the given values accorgingly sounds and pauses. Otherwise, please, check whether at --- least it can deal with such arguments without errors. 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@. -overSoXSynthGen2FDN_SG4G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Durations -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () -overSoXSynthGen2FDN_SG4G file m ku f y v2 wws h = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA - zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generalized version of the 'overSoXSynthGen2FDN_SG4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_SG4GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Durations -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () -overSoXSynthGen2FDN_SG4GPar file params f y v2 wws h = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInParamsV params . V.map fromIntegral $ vecA - zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Auxiliary function to get from a sound file specified a duration parameter @n@ that can be used further. -duration1000 :: FilePath -> IO Int -duration1000 file = fmap (\t -> truncate (t / 0.001)) . durationA $ file - --- | A variant of the 'overSoXSynthGen2FDN_SG4G' where instead of providing your own durations as 'Durations' you use a Ukrainian text and --- a function treats each symbol in it as a duration parameter with its sign. Positive values correspond to durations of the sounds generated --- and negative values -- to durations of the pauses respectively. Please, use a function @h :: ((Double -> OvertonesO) -> (Double, Double) -> --- Int -> String -> IO ())@ such that it can create for the given values accorgingly sounds and pauses. Otherwise, please, check whether at --- least it can deal with such arguments without errors. -overSoXSynthGen2FDN_SG4GS :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () -overSoXSynthGen2FDN_SG4GS file m ku f y zs = overSoXSynthGen2FDN_SG4G file m ku f y (str2Durations zs y) - --- | 6G generalized variant of the 'overSoXSynthGen2FDN_SG4G' with volume adjustments given by '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@. -overSoXSynthGen2FDN_SG6G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Durations -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Strengths -> Double -> IO () -overSoXSynthGen2FDN_SG6G file m ku f y v2 wws h v6 limV - | V.null v6 = putStrLn "You did not provide a volume adjustments vector! " - | otherwise = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA - zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav" - apply6GSilentFile ("result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") limV (V.unsafeIndex v6 (j `rem` V.length v6))) vecB - endFromResult - --- | Generalized version of the 'overSoXSynthGen2FDN_SG6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_SG6GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Durations -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Strengths -> Double -> IO () -overSoXSynthGen2FDN_SG6GPar file params f y v2 wws h v6 limV - | V.null v6 = putStrLn "You did not provide a volume adjustments vector! " - | otherwise = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInParamsV params . V.map fromIntegral $ vecA - zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav" - apply6GSilentFile ("result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") limV (V.unsafeIndex v6 (j `rem` V.length v6))) vecB - endFromResult - --- | A variant of the 'overSoXSynthGen2FDN_SG6G' where 'Strengths' are obtained from a Ukrainian text and 'str2Volume'. -overSoXSynthGen2FDN_SG6GS :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> String -> Double -> IO () -overSoXSynthGen2FDN_SG6GS file m ku f y zs wws h zzs = overSoXSynthGen2FDN_SG6G file m ku f y (str2Durations zs y) wws h (str2Volume zzs) - --- | A variant of the 'overSoXSynthGen2FDN_SG6GS' where 'Strengths' are obtained from the same Ukrainian text as also 'Durations' so the last --- 'String' argument is omitted (it is equal to the first one). Helps to create a speech-like composition. -overSoXSynthGen2FDN_SG6GSu :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Double -> IO () -overSoXSynthGen2FDN_SG6GSu file m ku f y zs wws h = overSoXSynthGen2FDN_SG6G file m ku f y (str2Durations zs y) wws h (str2Volume zs) - --- | A default way to get 'Durations' for the sounds up to 0.35.2.0 version of the package including. It is based on the number of Ukrainian --- sounds representations (see, 'convertToProperUkrainian') in a Ukrainian syllables or somewhat generated by the same rules as they. --- The rhythm using the function is very often not binary but its ratios are almost always a ratios of the small natural numbers (1, 2, 3, 4, 5, 6, 7 etc.). -str2DurationsDef :: Int -> String -> Double -> Durations -str2DurationsDef n zs y = - let (t, ws) = splitAt 1 . syllableStr n $ zs in V.map (\yy -> y * fromIntegral (yy * length ws) / fromIntegral (head t)) . V.fromList $ ws - --- | Generalized variant of the 'overSoXSynthGen2FDN_SG' with a possibility to specify with the third 'String' argument sound quality parameters. --- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. --- For more information, please, refer to 'soxBasicParams'. 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@. -overSoXSynthGen2FDN_SG2G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) -> - (Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () -overSoXSynthGen2FDN_SG2G file m ku f y zs wws h ys = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws ys - renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ - if drop 3 ys == "f" then ".flac" else ".wav") vecB - endFromResult2G ys - --- | Generalized version of the 'overSoXSynthGen2FDN_SG2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_SG2GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) -> - (Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () -overSoXSynthGen2FDN_SG2GPar file params f y zs wws h ys = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInParamsV params . V.map fromIntegral $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws ys - renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ - if drop 3 ys == "f" then ".flac" else ".wav") vecB - endFromResult2G ys - --- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. -overSoXSynthGen2FDN_S :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () -overSoXSynthGen2FDN_S file m ku f y zs wws = overSoXSynthGen2FDN_SG file m ku f y zs wws overSoXSynth2FDN_S - --- | Similar to 'overSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller --- by absolute value than 0.001. An 'Int' parameter is used to define an interval. To obtain compatible with versions prior to --- 0.20.0.0 behaviour, use for the 'Int' 0. --- --- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. --- But for a lot of functions this works well. --- --- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_Sf'. -overSoXSynth2FDN_Sf :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO () -overSoXSynth2FDN_Sf f (x, y) = overSoXSynth2FDN_Sf3 f (x, y, 0.001) - --- | Generalized variant of the 'overSoXSynth2FDN_Sf' with a possibility to adjust volume using 'adjust_dbVol'. 'V.Vector' of 'Double' is --- used to specify adjustments in dB. For more information, please, refer to 'adjust_dbVol'. -overSoXSynth2FDN_Sf1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () -overSoXSynth2FDN_Sf1G f (x, y) = overSoXSynth2FDN_Sf31G f (x, y, 0.001) - --- | Generalized variant of the 'overSoXSynth2FDN_Sf1G' with a possibility to specify sound quality using the second 'String' argument. --- For more information, please, refer to 'soxBasicParams'. -overSoXSynth2FDN_Sf2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () -overSoXSynth2FDN_Sf2G f (x, y) = overSoXSynth2FDN_Sf32G f (x, y, 0.001) - --- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf' function. 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@. -overSoXSynthGen2FDN_Sf :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () -overSoXSynthGen2FDN_Sf file m ku f y zs wws = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - overSoXSynth2FDN_Sf f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generalized version of the 'overSoXSynthGen2FDN_Sf' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_SfPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> String -> String -> IO () -overSoXSynthGen2FDN_SfPar file params f y zs wws = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInParamsV params . V.map fromIntegral $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - overSoXSynth2FDN_Sf f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Similar to 'overSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller --- than the third 'Double' parameter by an absolute value in the triple of @Double@'s. An 'Int' parameter is used to define an interval. To obtain compatible --- with versions prior to 0.20.0.0 behaviour, use for the 'Int' 0. --- --- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. --- But for a lot of functions this works well. --- --- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_Sf3'. -overSoXSynth2FDN_Sf3 :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO () -overSoXSynth2FDN_Sf3 f (x, y, t0) j zs = overSoXSynth2FDN_Sf32G f (x, y, t0) j zs V.empty [] - --- | Generalized variant of the 'overSoXSynth2FDN_Sf3' function with a possibility to adjust volume using 'adjust_dBVol'. 'V.Vector' of 'Double' --- specifies the needed adjustments in dB. -overSoXSynth2FDN_Sf31G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> IO () -overSoXSynth2FDN_Sf31G f (x, y, t0) j zs vdB = overSoXSynth2FDN_Sf32G f (x, y, t0) j zs vdB [] - --- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter. --- For more information, please, refer to 'soxBasicParams'. -overSoXSynth2FDN_Sf32G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () -overSoXSynth2FDN_Sf32G f (x, y, t0) j zs vdB ys - | V.null . convertToProperUkrainian $ zs = overSoXSynth x - | otherwise = do - let l0 = length zs - soundGenF32G (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0) - (dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))]) - (V.replicate 2 x) (V.fromList [1,V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))]) f (x, y, t0) j vdB ys - if null ys then mixTest else mixTest2G ys - --- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter. --- For more information, please, refer to 'soxBasicParams'. -overSoXSynth2FDN_Sf35G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () -overSoXSynth2FDN_Sf35G f (x, y, t0) j v5 vdB ys - | V.null v5 = overSoXSynth x - | otherwise = do - let l0 = V.length v5 - soundGenF32G (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0) - (dNote (V.unsafeIndex v5 (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))]) - (V.replicate 2 x) (V.fromList [1,V.unsafeIndex v5 (abs (j `rem` l0))]) f (x, y, t0) j vdB ys - if null ys then mixTest else mixTest2G ys - --- | Generalized variant of the 'overSoXSynth2FDN_Sf35G' with afterwards 'apply6G' usage. -overSoXSynth2FDN_Sf36G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () -overSoXSynth2FDN_Sf36G f (x, y, t0) j v5 vdB ys vol - | V.null v5 = overSoXSynth x - | otherwise = do - let l0 = V.length v5 - soundGenF32G (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0) - (dNote (V.unsafeIndex v5 (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))]) - (V.replicate 2 x) (V.fromList [1,V.unsafeIndex v5 (abs (j `rem` l0))]) f (x, y, t0) j vdB ys - if null ys then mixTest else mixTest2G ys - if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" - --- | A variant of the 'overSoXSynth2FDN_Sf36G' where volume adjustment is obtained from a Ukrainian text. -overSoXSynth2FDN_Sf36GS :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () -overSoXSynth2FDN_Sf36GS f (x, y, t0) j v5 xs vdB ys xxs - | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " - | otherwise = overSoXSynth2FDN_Sf36G f (x, y, t0) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) - -helpF1 :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> V.Vector (Maybe Double) -helpF1 vf vd = - V.map (\(f1,x,i2) -> - case i2 of - 0 -> Nothing - _ -> Just $ f1 x) . V.zip3 vf vd - -helpF0 :: Int -> String -helpF0 = - getBFst' ("ZZ0",V.fromList . zip [0..] $ (map (:[]) "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ++ concatMap (\z -> map ((z:) . (:[])) "ABCDEFGHIJKLMNOPQRSTUVWXYZ") - "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) - --- | Can generate multiple notes with their respective overtones that are played simultaneously (e. g. it can be just one note with overtones, --- an interval with overtones, an accord with overtones etc.). This allows to get a rather complex or even complicated behaviour to obtain expressive --- and rich sound. -soundGenF3 :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> IO () -soundGenF3 vf vd vi f (x, y, t0) j = soundGenF32G vf vd vi f (x, y, t0) j V.empty [] - --- | Generalized variant of the 'soundGenF3' with volume adjustment in dB given by the second @Vector Double@ for the overtones. -soundGenF31G :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> - V.Vector Double -> IO () -soundGenF31G vf vd vi f (x, y, t0) j vdB = soundGenF32G vf vd vi f (x, y, t0) j vdB [] - --- | Generalized variant of the 'soundGenF31G' with a possibility to specify sound quality using the 'String' argument. For more information, --- please, refer to 'soxBasicParams'. -soundGenF32G :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> - V.Vector Double -> String -> IO () -soundGenF32G vf vd vi f (x, y, t0) j vdB ys = do - let vD = helpF1 vf vd vi -- Vector of notes played simultaneously (e. g. just one, interval, accord etc.) - vDz = V.mapMaybe id vD -- The previous one without Nothings and Justs - ilDz = V.length vDz - 1 - vNotes = doubleVecFromVecOfDouble f t0 (V.map Just vDz) -- Vector of vectors of pairs (freq,ampl) -- notes and their absence (V.empty) with overtones - ts = showFFloat (Just 4) (abs y) "" -- duration of the sound to be generated - V.imapM_ (\i note1 -> do - _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ((if V.null vdB - then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth",ts, - "sine", showFFloat Nothing (V.unsafeIndex vDz i) "","vol", if compare y 0.0 == GT then "1.0" else "0"])) "" - partialTest_k2G (V.unsafeIndex vNotes i) i ts vdB ys) vDz - --- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf3' function. -overSoXSynthGen2FDN_Sf3 :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> IO () -overSoXSynthGen2FDN_Sf3 file m ku f y t0 zs wws = overSoXSynthGen2FDN_Sf3G file m ku f y t0 zs wws overSoXSynth2FDN_Sf3 - --- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf3' function. 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@. -overSoXSynthGen2FDN_Sf3G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO ()) -> IO () -overSoXSynthGen2FDN_Sf3G file m ku f y t0 zs wws h = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_Sf3GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO ()) -> IO () -overSoXSynthGen2FDN_Sf3GPar file params f y t0 zs wws h = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInParamsV params . V.map fromIntegral $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws - renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generalized variant of the 'ovorSoXSynthGen2FDN_Sf3G' with a possibility to specify sound quality with the third 'String' argument. --- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. --- For more information, please, refer to 'soxBasicParams'. 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@. -overSoXSynthGen2FDN_Sf3G2G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () -overSoXSynthGen2FDN_Sf3G2G file m ku f y t0 zs wws h ys = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws ys - renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f" - then ".flac" else ".wav") vecB - endFromResult2G ys - --- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_Sf3G2GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> - ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () -overSoXSynthGen2FDN_Sf3G2GPar file params f y t0 zs wws h ys = do - n <- duration1000 file - vecA <- freqsFromFile file n - let vecB = liftInParamsV params . V.map fromIntegral $ vecA - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do - h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws ys - renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f" - then ".flac" else ".wav") vecB - endFromResult2G ys - --- | Function to get from the number of semi-tones and a note a 'Maybe' note for the second lower note in the interval if any. If there is --- no need to obtain such a note, then the result is 'Nothing'. -dNote :: Int -> Double -> Maybe Double -dNote n note - | n == 0 || compare note (V.unsafeIndex notes 0) == LT || compare note (V.unsafeIndex notes 107) == GT = Nothing - | otherwise = Just (note / 2 ** (fromIntegral n / 12)) - --- | 'V.Vector' of musical notes in Hz. -notes :: V.Vector Double --- notes V.! 57 = 440.0 -- A4 in Hz -notes = V.generate 108 (\t -> 440 * 2 ** (fromIntegral (t - 57) / 12)) - --- | Function returns either the nearest two musical notes if frequency is higher than one for C0 and lower than one for B8 --- or the nearest note duplicated in a tuple. -neighbourNotes :: Double -> V.Vector Double -> (Double, Double) -neighbourNotes x v - | compare x (V.unsafeIndex v 0) /= GT = (V.unsafeIndex v 0, V.unsafeIndex v 0) - | compare x (V.unsafeIndex v (V.length v - 1)) /= LT = (V.unsafeIndex v (V.length v - 1), V.unsafeIndex v (V.length v - 1)) - | compare (V.length v) 2 == GT = if compare x (V.unsafeIndex v (V.length v `quot` 2)) /= GT - then neighbourNotes x (V.unsafeSlice 0 (V.length v `quot` 2 + 1) v) - else neighbourNotes x (V.unsafeSlice (V.length v `quot` 2) (V.length v - (V.length v `quot` 2)) v) - | otherwise = (V.unsafeIndex v 0, V.unsafeIndex v (V.length v - 1)) - --- | Returns the closest note to the given frequency in Hz. -closestNote :: Double -> Double -closestNote x - | compare x 0.0 == GT = - let (x0, x2) = neighbourNotes x notes - r0 = x / x0 - r2 = x2 / x in - if compare r2 r0 == GT - then x0 - else x2 - | otherwise = 0.0 - --- | Additional function to prepend zeroes to the given 'String'. The number of them are just that one to fulfill the length to the given 'Int' parameter. -prependZeroes :: Int -> String -> String -prependZeroes n xs - | if compare n 0 /= GT || null xs then True else compare n (length xs) /= GT = xs - | otherwise = replicate (n - length xs) '0' ++ xs -{-# INLINE prependZeroes #-} - -nOfZeroesLog :: Int -> Maybe Int -nOfZeroesLog x - | compare x 0 /= GT = Nothing - | otherwise = Just (truncate (logBase 10 (fromIntegral x)) + 1) -{-# INLINE nOfZeroesLog #-} - --- | Is a minimal number of decimal places that are just enough to represent a length of the 'V.Vector' given. For an 'V.empty' returns 0. -numVZeroesPre :: V.Vector a -> Int -numVZeroesPre v = fromMaybe (0 :: Int) (nOfZeroesLog . V.length $ v) -{-# INLINE numVZeroesPre #-} - --- | Function is used to generate a rhythm of the resulting file \'end.wav\' from the Ukrainian text and a number of sounds either in the syllables or in the words without vowels. -syllableStr :: Int -> String -> [Int] -syllableStr n xs = - let ps = take n . cycle . concat . sylLengthsP2 . syllablesUkrP $ xs - y = sum ps in - case y of - 0 -> [0] - _ -> y:ps - --- | Similarly to 'liftInOctaveV' returns a 'V.Vector' 'Double' (actually frequencies) for the n-th elements set of notes (see 'nkyT') instead of octaves. --- A second 'Int' parameter defines that @n@. -liftInEnkuV :: Int -> Int -> V.Vector Double -> V.Vector Double -liftInEnkuV n ku = V.mapMaybe (liftInEnku n ku) - --- | Similarly to 'liftInOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). --- A second 'Int' parameter defines that @n@. Not all pairs return 'Just' @x@. -liftInEnku :: Int -> Int -> Double -> Maybe Double -liftInEnku n ku x - | compare n 0 == LT || compare n ((108 `quot` ku) - 1) == GT = Nothing - | getBFst' (False, V.fromList . zip [2,3,4,6,9,12] $ repeat True) ku && compare (closestNote x) 24.4996 == GT = - case compare (fromJust . whichEnka ku $ x) n of - EQ -> Just (closestNote x) - LT -> let z = logBase 2.0 (V.unsafeIndex notes (n * ku) / 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) (enkuUp ku) $ closestNote x) - else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 2) (enkuUp ku) $ closestNote x) - _ -> let z = logBase 2.0 (closestNote x / V.unsafeIndex notes (n * ku)) - 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) (enkuDown ku) $ closestNote x) - else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 1) (enkuDown ku) $ closestNote x) - | otherwise = Nothing - --- | Similarly to 'whichOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). --- An 'Int' parameter defines that @n@. -whichEnka :: Int -> Double -> Maybe Int -whichEnka n x - | getBFst' (False,V.fromList . zip [2,3,4,6,9,12] $ repeat True) n && compare (closestNote x) 24.4996 == GT = (\t -> - case isJust t of - True -> fmap (\z -> - case z of - 0 -> z - _ -> z - 1) t - _ -> Just ((108 `quot` n) - 1)) . V.findIndex (\(t1, t2) -> compare (closestNote x) t1 == LT) $ nkyT n - | otherwise = Nothing - --- | Returns an analogous note in the higher n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@. -enkuUp :: Int -> Double -> Double -enkuUp n x - | getBFst' (False, V.fromList . zip [2..11] $ repeat True) n = 2 ** (fromIntegral n / 12) * x - | otherwise = 2 * x -{-# INLINE enkuUp #-} - --- | Returns an analogous note in the lower n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@. -enkuDown :: Int -> Double -> Double -enkuDown n x - | getBFst' (False, V.fromList . zip [2..11] $ repeat True) n = 2 ** (fromIntegral (-n) / 12) * x - | otherwise = x / 2 -{-# INLINE enkuDown #-} - ------------------------------------------------------------------------------------------------------------------- - --- | Function is used to get numbers of intervals from a Ukrainian 'String'. It is used internally in the 'uniqOverSoXSynthN4' function. -intervalsFromString :: String -> Intervals -intervalsFromString = vStrToVIntG defInt . convertToProperUkrainian - --- | Generatlized version of the 'intervalsFromString' with a possibility to specify your own 'Intervals'. -intervalsFromStringG :: Intervals -> String -> Intervals -intervalsFromStringG v = vStrToVIntG v . convertToProperUkrainian - --- | The default way to get 'Intervals' from a converted Ukrainian text. -vStrToVInt :: V.Vector String -> Intervals -vStrToVInt = V.map (strToIntG defInt) - --- | Generatlized version of the 'vStrToVInt' with a possibility to specify your own 'Intervals'. -vStrToVIntG :: Intervals -> V.Vector String -> Intervals -vStrToVIntG v = V.map (strToIntG v) - --- | The default way to get number of semi-tones between notes in a single element of 'Intervals'. -strToInt :: String -> Int -strToInt = strToIntG defInt -{-# INLINE strToInt #-} - --- | Default values for 'strToInt'. All the intervals are not greater than one full octave. -defInt :: Intervals -defInt = V.fromList [12,4,7,3,4,5,5,12,3,8,12,7,10,7,7,7,12,10,7,10,2,12,2,2,11,11,1,12,9] -{-# INLINE defInt #-} - --- | Generatlized version of the 'strToInt' with a possibility to specify your own 'Intervals'. -strToIntG :: Intervals -> String -> Int -strToIntG v = - getBFst' (0, V.zip (V.fromList ["а","б","в","г","д","дж","дз","е","ж","з","и","й","к","л","м","н","о","п","р","с","т","у","ф","х","ц","ч","ш", - "і","ґ"]) v) -{-# INLINE strToIntG #-} - ---------------------------------------------------------------------------------------------------------------------- - --- | Arithmetic average for the 'V.Vector' is used as a weight for a duration. -doublesAveragedA :: V.Vector Double -> Double -> V.Vector Double -doublesAveragedA v4 y3 - | V.null v4 || y3 == 0 = V.empty - | otherwise = let aver = V.sum v4 / fromIntegral (V.length v4) in if aver == 0.0 then doublesAveragedA (V.filter (/= 0.0) v4) y3 - else V.map (\t4 -> t4 * y3 / aver) v4 - --- | Geometric average for the 'V.Vector' is used as a weight for a strength. -doublesAveragedG :: V.Vector Double -> Double -> V.Vector Double -doublesAveragedG v4 y3 - | V.null v4 || y3 == 0 = V.empty - | otherwise = let aver = V.product v4 ** (fromIntegral 1 / (fromIntegral (V.length v4))) in if aver == 0.0 then doublesAveragedG (V.filter (/= 0.0) v4) y3 - else V.map (\t4 -> t4 * y3 / aver) v4 - --- | 'Durations' accounting the desired average duration. -durationsAver :: Durations -> Double -> Durations -durationsAver = doublesAveragedA - --- | 'Strengths' accounting the desired average strength. -strengthsAver :: Strengths -> Double -> Strengths -strengthsAver = doublesAveragedG - --- | 'StrengthsDb' accounting the desired average strength in dB. -strengthsDbAver :: StrengthsDb -> Double -> StrengthsDb -strengthsDbAver = doublesAveragedG - --- | Auxiliar function to make all vectors in a 'V.Vector' equal by length (the minimum one). -equalize2Vec :: V.Vector (V.Vector a) -> V.Vector (V.Vector a) -equalize2Vec v = let min = V.minimum . V.map V.length $ v in V.map (V.unsafeSlice 0 min) v - --- | A full conversion to the 'Durations' from a Ukrainian text. -str2Durations :: String -> Double -> Durations -str2Durations xs y - | compare y 0.0 == GT && not (null xs) = durationsAver (V.map str2Durat1 . convertToProperUkrainian $ xs) y - | otherwise = V.empty - --- | A conversion to the 'Double' that is used inside 'str2Durations'. -str2Durat1 :: String -> Double -str2Durat1 = getBFst' ((-0.153016), V.fromList [("-", (-0.101995)), ("0", (-0.051020)), ("1", (-0.153016)), ("а", 0.138231), ("б", 0.057143), - ("в", 0.082268), ("г", 0.076825), ("д", 0.072063), ("дж", 0.048934), ("дз", 0.055601), ("е", 0.093605), ("ж", 0.070658), ("з", 0.056054), - ("и", 0.099955), ("й", 0.057143), ("к", 0.045351), ("л", 0.064036), ("м", 0.077370), ("н", 0.074240), ("о", 0.116463), ("п", 0.134830), - ("р", 0.049206), ("с", 0.074603), ("сь", 0.074558), ("т", 0.110658), ("у", 0.109070), ("ф", 0.062268), ("х", 0.077188), ("ц", 0.053061), - ("ць", 0.089342), ("ч", 0.057596), ("ш", 0.066077), ("ь", 0.020227), ("і", 0.094150), ("ґ", 0.062948)]) - --- | A full conversion to the 'Strengths' from a Ukrainian text. -str2Volume :: String -> Strengths -str2Volume = V.map (getBFst' (0.0, V.fromList [("а", 0.890533), ("б", 0.211334), ("в", (-0.630859)), ("г", (-0.757599)), ("д", 0.884613), ("дж", 0.768127), - ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.588959)), ("з", (-0.528870)), ("и", 0.770935), ("й", (-0.708008)), ("к", (-0.443085)), - ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", 0.124908), ("р", 0.647369), ("с", 0.155640), ("сь", (-0.207764)), - ("т", -0.304443), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)), ("ць", 0.381348), ("ч", (-0.189240)), - ("ш", 0.251221), ("ь", 0.495483), ("і", (-0.682709)), ("ґ", 0.557098)])) . convertToProperUkrainian - --- | A conversion to the 'Double' that is used inside 'str2Volume'. -str2Vol1 :: String -> Double -str2Vol1 = getBFst' (0.0, V.fromList [("а", 0.890533), ("б", 0.211334), ("в", (-0.630859)), ("г", (-0.757599)), ("д", 0.884613), ("дж", 0.768127), - ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.588959)), ("з", (-0.528870)), ("и", 0.770935), ("й", (-0.708008)), ("к", (-0.443085)), - ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", 0.124908), ("р", 0.647369), ("с", 0.155640), ("сь", (-0.207764)), - ("т", -0.304443), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)), ("ць", 0.381348), ("ч", (-0.189240)), - ("ш", 0.251221), ("ь", 0.495483), ("і", (-0.682709)), ("ґ", 0.557098)]) . V.unsafeHead . convertToProperUkrainian - --- | For the given non-existing 'FilePath' for a sound file supported by SoX generates a silence of the specified duration and quality (see, --- 'soxBasicParams'). -silentSound2G :: FilePath -> Double -> String -> IO () -silentSound2G file y4 ys = do - _ <- readProcessWithExitCode (fromJust (showE "sox")) - ((if null ys then id else soxBasicParams ys) ["-r22040","-n",file,"synth", showFFloat (Just 1) y4 "","sine","440.0","vol","0"]) "" - putStr "" - --- | After producing sounds as WAV or FLAC files you can apply to them volume adjustments using 'Strengths'. The first 'String' is used accordingly to --- 'soxBasicParams' and the second one -- as a prefix of the filenames for the files that the function is applied to. The files must not be silent ones. --- Otherwise, it leads to likely noise sounding or errors. -apply6G :: Strengths -> String -> String -> IO () -apply6G v6 ys zs - | V.null v6 = putStrLn "Nothing changed, because the vector of volume adjustments is empty! " - | otherwise = do - dir0v <- listVDirectory3G ys zs - V.imapM_ (\i file -> soxE file ["norm","vol", showFFloat (Just 4) (V.unsafeIndex v6 (i `rem` V.length v6)) ""]) dir0v - --- | Apply volume adjustment to the sound file. It must not be silent. Otherwise, it leads to likely noise sounding or errors. -apply6Gf :: Double -> FilePath -> IO () -apply6Gf vol file = soxE file ["norm","vol", showFFloat (Just 4) vol ""] - --- | Variant of the 'apply6G' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as a first 'String' argument. --- It uses 'str2Volume' inside. The files must not be silent ones. Otherwise, it leads to likely noise sounding or errors. -apply6GS :: String -> String -> String -> IO () -apply6GS xs = apply6G (str2Volume xs) - -apply6GSilentFile :: FilePath -> Double -> Double -> IO () -apply6GSilentFile file limV vol = do - upp <- upperBnd file - ampL2 <- fmap ((\zz -> read zz::Double) . fst) (selMaxAbs file (0,upp)) - if compare (abs ampL2) (abs limV) /= GT then putStr "" - else apply6Gf vol file - --- | Variant of the 'apply6G' function which can be applied also to the silent files. Whether a file is silent is defined using the 'Double' argument --- so that if the maximum by absolute value amplitude is less by absolute value than the 'Double' argument then the file is not changed. -apply6G2 :: Strengths -> String -> String -> Double -> IO () -apply6G2 v6 ys zs limV - | V.null v6 = putStrLn "Nothing changed, because the vector of volume adjustments is empty! " - | otherwise = do - dir0v <- listVDirectory3G ys zs - V.imapM_ (\i file -> apply6GSilentFile file limV (V.unsafeIndex v6 (i `rem` V.length v6))) dir0v - --- | Variant of the 'apply6G2' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as the first 'String' argument. --- It uses 'str2Volume' inside. -apply6GS2 :: String -> String -> String -> Double -> IO () -apply6GS2 xs = apply6G2 (str2Volume xs) - ------------------------------------------------------------------------------------------------------------------------ - --- | Returns a 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the sets consisting of @n@ consequential notes --- (including semi-tones). An 'Int' parameter defines this @n@. It can be 2, 3, 4, 6, 9, or 12 (the last one is for default octaves, see 'octavesT'). --- So for different valid @n@ you obtain doubles, triples and so on. The function being applied returns a 'V.Vector' of such sets with --- their respective lowest and highest frequencies. -nkyT :: Int -> NotePairs -nkyT n - | getBFst' (False,V.fromList . zip [2,3,4,6,9,12] $ repeat True) n = V.generate (108 `quot` n) (\i -> (V.unsafeIndex notes (i * n), - V.unsafeIndex notes (i * n + (n - 1)))) - | otherwise = octavesT - --- | Returns a 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the octaves. -octavesT :: NotePairs -octavesT = V.generate 9 (\i -> (V.unsafeIndex notes (i * 12), V.unsafeIndex notes (i * 12 + 11))) - --- | 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*\" and \"end.wav\" files in the current directory, because they can be overwritten. -overSoXSynth :: Double -> IO () -overSoXSynth x = do - let note0 = if x /= 0.0 then closestNote (abs x) else V.unsafeIndex notes 0 - note1 = pureQuintNote note0 - v0 = overTones note0 - v1 = overTones note1 - overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") - overSoXSynthHelp2 = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) - ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") - _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", showFFloat Nothing note0 "", "synth", "0.5","sine", "mix", showFFloat Nothing note1 "", "vol","0.5"] "" - overSoXSynthHelp v0 - overSoXSynthHelp2 v1 - mixTest - --- | Returns a pure quint lower than the given note. -pureQuintNote :: Double -> Double -pureQuintNote x = x / 2 ** (7 / 12) -{-# INLINE pureQuintNote #-} - --- | 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. -overTones :: Double -> OvertonesO -overTones note = - V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.zip (V.generate 1024 (\i -> - note * fromIntegral (i + 2))) $ (V.generate 1024 (\i -> 1 / fromIntegral ((i + 1) * (i + 1)))) - ------------------------------------------------------------------------------------ - --- | Gets a function @f::Double -> OvertonesO@ that can be used further. Has two variants with usage of 'closestNote' ('Int' argument is greater than 0)v --- and without it ('Int' argument is less than 0). For both cases 'String' must be in a form list of tuples of pairs of 'Double' to get somewhat --- reasonable result. The function @f@ can be shown using a special printing function 'showFFromStrVec'. It is a simplest multiplicative (somewhat --- acoustically and musically reasonable) form for the function that can provide such a result that fits into the given data. --- --- > let (y,f1) = fromJust (maybeFFromStrVec 1 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783) --- > --- > (3520.0,[(25.829079975681818,0.2486356),(37.936206670369316,0.6464867),(494.9891484317899,0.374618646),(803.9138234326421,0.463486461)]) --- > --- > let (y,f1) = fromJust (maybeFFromStrVec (-1) 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783) --- > --- > (3583.9783,[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]) --- -maybeFFromStrVec :: Int -> Double -> String -> Maybe (Double,(Double -> V.Vector (Double,Double))) -maybeFFromStrVec n x ys - | n == 0 || null ys = Nothing - | n > 0 = - let y = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - v = readMaybe ys::Maybe (V.Vector (Double,Double)) - v2 = fromMaybe V.empty v - v3 = V.map (\(t,w) -> t / y) v2 in - if V.null v3 then Nothing - else Just (y,(\t1 -> V.imap (\i (t2,ampl2) -> ((V.unsafeIndex v3 i) * t1,ampl2)) v2)) - | otherwise = - let y = (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - v = readMaybe ys::Maybe (V.Vector (Double,Double)) - v2 = fromMaybe V.empty v - v3 = V.map (\(t,w) -> t / y) v2 in - if V.null v3 then Nothing - else Just (y,(\t1 -> V.imap (\i (t2,ampl2) -> ((V.unsafeIndex v3 i) * t1,ampl2)) v2)) - --- | Gets multiplication coefficients for @f::Double -> Vector (Double,Double)@ from the 'maybeFFromStrVec' with the same arguments. -fVecCoefs :: Int -> Double -> String -> V.Vector Double -fVecCoefs n x ys = - let rs = maybeFFromStrVec n x ys in - case rs of - Nothing -> V.empty - _ -> - let (y,f1) = fromJust rs in - V.map fst (f1 1) - --- | Experimental 'show' for @f::Double -> Vector (Double,Double)@ that is used only for visualisation. It is correct only with 'maybeFFromStrVec' or --- equivalent function. Because the shape of the @f@ is known the function can be defined. --- --- > showFFromStrVec (-1) 440 "[(25.358,0.3598),(489.35,0.4588962),(795.35,0.6853)]" --- > --- > "(440.00,(\t -> <(0.05763181818181818 * t, 0.3598),(1.112159090909091 * t, 0.4588962),(1.8076136363636364 * t, 0.6853)>))" --- -showFFromStrVec :: Int -> Double -> String -> String -showFFromStrVec n x ys - | isNothing . maybeFFromStrVec n x $ ys = "" - | otherwise = - let (y,f) = fromJust . maybeFFromStrVec n x $ ys - l = length ("(" ++ (showFFloat Nothing y "") ++ ",(\t -> <(" ++ concat (V.toList . V.map (\z -> (showFFloat Nothing (fst z) $ - " * t, " ++ (showFFloat Nothing (snd z) "),("))) $ (f 1))) in take (l - 2) ("(" ++ (showFFloat Nothing y "") ++ ",(\t -> <(" - ++ concat (V.toList . V.map (\z -> (showFFloat Nothing (fst z) " * t, " ++ (showFFloat Nothing (snd z) "),("))) $ (f 1))) ++ ">))" - ----------------------------------------------------------------------------------------- - --- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not 'V.empty') is equal by the absolute value --- to 1.0 and the mutual ratios of the amplitudes are preserved. -renormF :: OvertonesO -> OvertonesO -renormF v - | V.null v = V.empty - | otherwise = - let v1 = V.fromList . sortBy (\(x1,y1) (x2,y2)-> compare (abs y2) (abs y1)) . V.toList $ v in - if (\(x,y) -> y == 0.0) . V.unsafeIndex v1 $ 0 then V.empty - else V.map (\(x,y) -> (x, y / (snd . V.unsafeIndex v1 $ 0))) v1 - --- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not 'V.empty') is equal by the absolute value --- to 'Double' argument and the mutual ratios of the amplitudes are preserved. -renormFD :: Double -> OvertonesO -> OvertonesO -renormFD ampl0 v - | V.null v = V.empty - | otherwise = - let v1 = V.fromList . sortBy (\(x1,y1) (x2,y2)-> compare (abs y2) (abs y1)) . V.toList $ v in - if (\(x,y) -> y == 0.0) . V.unsafeIndex v1 $ 0 then V.empty - else V.map (\(x,y) -> (x, ampl0 * y / (snd . V.unsafeIndex v1 $ 0))) v1 - --- | Predicate to check whether all tuples in a 'V.Vector' have the same first element. -sameOvertone :: OvertonesO -> Bool -sameOvertone v - | V.null v = False - | otherwise = V.all (\(x,_) -> x == (fst . V.unsafeIndex v $ 0)) v - --- | Similar to 'sameOvertone', except that not the 'V.Vector' is checked but a corresponding list. -sameOvertoneL :: [(Double,Double)] -> Bool -sameOvertoneL xs@((x,y):_) = all (\(xn,_) -> xn == x) xs -sameOvertoneL _ = False - --- | @g :: (Double,Double) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'. It depends --- only on the element being added and the actual 'OvertonesO'. It does not depend on the 'Double' argument for @f :: Double -> OvertonesO@ --- so for different 'Double' for @f@ it gives the same result. -sameFreqF :: Double -> (Double,Double) -> (Double -> OvertonesO) -> ((Double,Double) -> OvertonesO -> OvertonesO) -> OvertonesO -sameFreqF freq (noteN0,amplN0) f g = g (noteN0,amplN0) (f freq) - --- | @g :: (Double,Double) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'. --- Variant of 'sameFreqF' where g depends only on the elements of the 'OvertonesO', which first elements in the tuples equal to the first element --- in the @(Double,Double)@. It does not depend on the 'Double' argument for @f :: Double -> OvertonesO@ --- so for different 'Double' for @f@ it gives the same result. -sameFreqFI :: Double -> (Double,Double) -> (Double -> OvertonesO) -> ((Double,Double) -> OvertonesO -> OvertonesO) -> OvertonesO -sameFreqFI freq (noteN0,amplN0) f g = g (noteN0,amplN0) . V.filter (\(x,y) -> x == noteN0) $ f freq - --- | @gAdd :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO@ is a function that defines how the element is added --- to the 'OvertonesO'. 'fAddFElem' is --- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task --- (in general) to look at such a function through a prism of notion of operator (mathematical, for example similar to that ones that --- are used for quantum mechanics and quantum field theory). --- @gAdd@ allows not only to insert an element if missing, but to change all the 'OvertonesO' system. So depending on the complexity, --- it can produce rather complex behaviour. -fAddFElem :: (Double, Double) -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Double -> OvertonesO) -fAddFElem (noteN, amplN) f gAdd t = gAdd (noteN, amplN) t f - --- | @gRem:: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO@ is a function that defines how the element is removed --- from the 'OvertonesO'. 'fRemoveFElem' is --- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task --- (in general) to look at such a function through a prism of notion of operator (mathematical, for example that ones that are used --- for quantum mechanics and quantum field theory). --- @gRem@ allows not only to delete an element if existing, but to change all the 'OvertonesO' system. So depending on the complexity, --- it can produce rather complex behaviour. -fRemoveFElem :: (Double, Double) -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Double -> OvertonesO) -fRemoveFElem (noteN, amplN) f gRem t = gRem (noteN, amplN) t f - --- | Changes elements of the 'OvertonesO' using two functions. It is a generalization of the 'fAddFElem' and 'fRemoveFElem' functions. For example, if the first --- of the two inner functional arguments acts as 'gAdd01' or similar, then it adds element to the 'OvertonesO', if it acts as 'gRem01', then it removes the element. --- Its behaviour is defined by the 'Double' parameter (meaning frequency, probably), so you can change elements depending on what point it is applied. -fChangeFElem :: (Double, Double) -> Double -> (Double -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO)) -> (Double -> OvertonesO) -> - (Double -> OvertonesO) -fChangeFElem (noteN, amplN) freq h f t = (h freq) (noteN, amplN) t f - --- | Example of the function gAdd for the 'fAddFElem'. If the frequency is already in the 'OvertonesO' then the corresponding amplitude is divided --- equally between all the elements with the repeated given frequency from @(Double, Double)@. Otherwise, it is just concatenated to the 'OvertonesO'. -gAdd01 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO -gAdd01 (note,ampl) freq f - | V.null . f $ freq = V.singleton (note,ampl) - | otherwise = - let v1 = renormF . f $ freq in - let v2 = V.findIndices (\(x,_) -> x == note) v1 in - if V.null v2 then V.cons (note,ampl) (f freq) - else renormF . V.imap (\i (t,w) -> if i `V.elem` v2 then (t,w + ampl / fromIntegral (V.length v2)) else (t,w)) $ v1 - --- | Can be used to produce an example of the function @gAdd@ for the 'fAddFElem'. Similar to 'gAdd01', but uses its first argument --- to renorm the result of the 'gAdd01' so that its maximum by absolute value amplitude equals to the first argument. -gAdd02 :: Double -> (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO -gAdd02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq - --- | Example of the function @gAdd@. for the 'fAddFElem'. If the frequency is not already in the 'OvertonesO' then the corresponding element is added and --- the 'OvertonesO' are renormed with 'renormF'. Otherwise, the element is tried to be inserted with a new frequency between the greatest by an absolute --- values notes as an intermediate value with the respective amplitude, or if there is only one element, to produce two elements in --- the resulting 'V.Vector' with two consequent harmonics. -gAdd03 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO -gAdd03 (note,ampl) freq f - | V.null . f $ freq = V.singleton (note,ampl) - | otherwise = - let v1 = renormF . f $ freq in - let v2 = V.findIndices (\(x,_) -> x == note) v1 in - if V.null v2 then renormF . V.cons (note,ampl) $ f freq - else - let xs = sortBy (\(x1,y1) (x2,y2)-> compare (abs x2) (abs x1)) . V.toList $ v1 - l = V.length v1 - ys = if compare l 1 == GT then ((fst . head $ xs) + (fst . head . tail $ xs) / 2,ampl):xs - else [(note,((snd . V.unsafeIndex v1 $ 0) + ampl) / 2),(2 * note,(abs ((snd . V.unsafeIndex v1 $ 0) - ampl)) / 2)] in - renormF . V.fromList $ ys - --- | Example of the function gRem for the 'fRemoveFElem'. If the element is already in the 'OvertonesO' then it is removed (if there are more than 5 --- elements already) and 'OvertonesO' are renormalized. Otherwise, all the same for the element already existing elements become less in an amlitude --- for a numbers that in sum equal to amplitude of the removed element. -gRem01 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO -gRem01 (note,ampl) freq f - | V.null . f $ freq = V.empty - | otherwise = - let v1 = renormF . f $ freq in - let v2 = V.findIndices (\(x,y) -> x == note && y == ampl) v1 in - if V.null v2 then - if compare (V.length v1) 5 == GT then renormF . V.unsafeSlice 0 (V.length v1 - 1) $ v1 - else v1 - else renormF . V.imap (\i (t,w) -> if i `V.elem` v2 then (t,w - ampl / fromIntegral (V.length v2)) else (t,w)) $ v1 - --- | Can be used to produce an example of the function @gRem@ for the 'fRemoveFElem'. Similar to 'gRem01', but uses its first argument --- to renorm the result of the 'gRem01' so that its maximum by absolute value amplitude equals to the first argument. -gRem02 :: Double -> (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO -gRem02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq - --- | Similar to 'fAddFElem', but instead of one element @(Double,Double)@ it deals with a 'V.Vector' of such elements that is 'OvertonesO'. -fAddFElems :: OvertonesO -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Double -> OvertonesO) -fAddFElems v f gAdds t = gAdds v t f - --- | Similar to 'fRemoveFElem', but instead of one element @(Double,Double)@ it deals with a 'V.Vector' of such elements that is 'OvertonesO'. -fRemoveFElems :: OvertonesO -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Double -> OvertonesO) -fRemoveFElems v f gRems t = gRems v t f - --- | Similar to 'fChangeFElem', but use another form of the changing function, so it can deal with not only single element of the 'OvertonesO', --- but also with several ones. -fChangeFElems :: OvertonesO -> Double -> (Double -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO)) -> (Double -> OvertonesO) -> - (Double -> OvertonesO) -fChangeFElems v freq h f t = (h freq) v t f - --- | Binary predicate to check whether two given 'OvertonesO' both have the elements with the same first element in the tuples. If 'True' then --- this means that 'OvertonesO' are at least partially overlaped by the first elements in the tuples (meaning frequencies). -freqsOverlapOvers :: OvertonesO -> OvertonesO -> Bool -freqsOverlapOvers v1 v2 = - let [v11,v21] = map (V.map fst) [v1,v2] - v22 = V.filter (<= V.maximum v11) v21 in - if V.null v22 then False - else - let v12 = V.filter (>= V.minimum v21) v11 - [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22] - [l1,l2] = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT - --- | Similar to 'freqsOverlapOvers', but checks whether the whole tuples are the same instead of the first elements in the tuples are the same. -elemsOverlapOvers :: OvertonesO -> OvertonesO -> Bool -elemsOverlapOvers v1 v2 = - let v22 = V.filter (\(x,_) -> x <= fst (V.maximumBy (\(x1,y) (t,u) -> compare x1 t) v1)) v2 in - if V.null v22 then False - else - let v12 = V.filter (\(x,_) -> x >= fst (V.minimumBy (\(x1,y) (t,u) -> compare x1 t) v2)) v1 - [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22] - [l1,l2] = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT - --- | Example of the function @gAdds@ for the 'fAddFElems'. -gAdds01 :: OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO -gAdds01 v0 freq f - | V.null . f $ freq = v0 - | freqsOverlapOvers v0 (f freq) = - let ys = sortBy (\(x1,y1) (x2,y2) -> compare x1 x2) . V.toList $ v0 - h ys - | null ys = [] - | otherwise = (takeWhile (not . (/= head ys)) ys):h (dropWhile (not . (/= head ys)) ys) - h1 = map (\zs -> (sum . map snd $ zs) / fromIntegral (length zs)) . h - h2 ys = map (fst . head) (h ys) - v2 = V.fromList . zip (h2 ys) $ (h1 ys) - us = sortBy (\(x1,y1) (x2,y2) -> compare x1 x2) . V.toList $ f freq - v3 = V.fromList . zip (h2 us) $ (h1 us) in renormF . V.concat $ [v2,v3] - | otherwise = renormF . V.concat $ [v0, f freq] - --- | Can be used to produce an example of the function @gAdds@ for the 'fAddFElems'. Similar to 'gAdds01', but uses its first argument --- to renorm the result of the 'gAdds01' so that its maximum by absolute value amplitude equals to the first argument. -gAdds02 :: Double -> OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO -gAdds02 amplMax v0 freq = renormFD amplMax . gAdds01 v0 freq - --- | Example of the function @gAdd@. for the 'fAddFElem'. It tries to insert the given ('Double','Double') into the less dense frequency region. -gAdd04 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO -gAdd04 (note,ampl) freq f - | V.null . f $ freq = V.singleton (note,ampl) - | otherwise = - let v1 = V.fromList . sortBy (\(x1,y1) (x2,y2) -> compare x1 x2) . V.toList . f $ freq - v2 = V.zipWith (\(x1,_) (x2,_) -> x2 - x1) v1 (V.unsafeSlice 1 (V.length v1 - 1) v1) - idxMax = V.maxIndex v2 - newFreq = (fst (V.unsafeIndex v1 (idxMax + 1)) + fst (V.unsafeIndex v1 idxMax)) / 2 in (newFreq,ampl) `V.cons` v1 - --- | Example of the function @gRem@ for the 'fRemFElem'. It tries not to remove elements from the less than 6 elements 'OvertonesO' and to remove --- all the elements in the given range with the width of the twice as many as the second 'Double' in the first argument tuple and the centre --- in the first 'Double' in the tuple. Similar to somewhat bandreject filter but with more complex behaviour for the sound to be more complex. -gRem03 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO -gRem03 (note,halfwidth) freq f = - let v1 = V.filter (\(x,y) -> compare (abs (x - note)) halfwidth /= GT) . f $ freq in - if compare (V.length v1) 5 /= GT then renormF . V.generate 5 $ (\i -> (fromIntegral (i + 1) * note, halfwidth / fromIntegral (i + 3))) - else v1 - --- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number @n@ (specified by the first 'Int' argument) of 'OvertonesO' --- (represented finally as a 'V.Vector' of them respectively) so that all except the first @n@ greatest by the absolute value of the amplitude --- tuples of Doubles are considered overtones for the greatest by the absolute value one in the given 'OvertonesO' and all the next @n - 1@ --- are treated as the greatest by the absolute value and each of them produces the similar by the @f :: Double -> OvertonesO@ function overtones. --- --- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar ones with different heights. --- To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one. -splitO :: Int -> OvertonesO -> V.Vector OvertonesO -splitO n v0 - | compare (V.length v0) (n + 1) == GT = - let v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - (x0, y0) = V.unsafeIndex v1 0 - v2 = V.unsafeSlice 1 (n - 1) v1 - v31 = V.map (\t -> (fst t) / x0) v2 - v32 = V.map (\t -> (snd t) / y0) v2 - v3 = V.zip v31 v32 - f1Tup (t1, w2) = V.imap (\ i (u1, u2) -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 - in V.map f1Tup (V.unsafeSlice 0 n v1) - | otherwise = V.singleton v0 - --- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number of 'OvertonesO' (represented finally as a 'V.Vector' of them repsectively) --- so that it intermediately uses a special function before applying the \"similarization\" splitting function. Is a generalization of the 'splitO', --- which can be considered a 'splitO2' with a first command line argument equals to 'id'. --- --- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar (less or more, depending on @h :: OvertonesO -> OvertonesO@) --- ones with different heights. To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one. -splitO2 :: (OvertonesO -> OvertonesO) -> Int -> OvertonesO -> V.Vector OvertonesO -splitO2 h n v0 - | compare (V.length v0) (n + 1) == GT = - let v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - (x0, y0) = V.unsafeIndex v1 0 - v2 = V.unsafeSlice 1 (n - 1) v1 - v31 = V.map (\t -> (fst t) / x0) v2 - v32 = V.map (\t -> (snd t) / y0) v2 - v3 = V.zip v31 v32 - f1Tup (t1, w2) = V.imap (\ i (u1, u2) -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 - in V.map f1Tup (h . V.unsafeSlice 0 n $ v1) - | otherwise = V.singleton v0 - --- | Generalized variant of the 'splitO' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument. -splitOG1 :: String -> Int -> OvertonesO -> V.Vector OvertonesO -splitOG1 xs n v0 - | compare (V.length v0) (n + 1) == GT = - let c1s = take 2 . filter isAsciiLower $ xs - v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - (x0, y0) = V.unsafeIndex v1 0 in - case c1s of - "ab" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,n - 1,V.length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) - "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,V.length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) - "ad" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) - _ -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) - | otherwise = V.singleton v0 - --- | Auxiliary function that is used inside 'splitOG1'. -splitHelp1 :: Int -> Int -> Int -> Int -> OvertonesO -> (Double,Double) -> V.Vector OvertonesO -splitHelp1 x1 x2 x3 x4 v00 (y5,y6) = - let v2 = V.unsafeSlice x1 x2 v00 - v31 = V.map (\t -> (fst t) / y5) v2 - v32 = V.map (\t -> (snd t) / y6) v2 - v3 = V.zip v31 v32 - f1Tup (t1, w2) = V.imap (\ i (u1, u2) -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 - in V.map f1Tup (V.unsafeSlice x3 x4 v00) - --- | Auxiliary function that is used inside 'splitOG2'. -splitHelp2 :: (OvertonesO -> OvertonesO) -> Int -> Int -> Int -> Int -> OvertonesO -> (Double,Double) -> V.Vector OvertonesO -splitHelp2 h1 x1 x2 x3 x4 v00 (y5,y6) = - let v2 = V.unsafeSlice x1 x2 v00 - v31 = V.map (\t -> (fst t) / y5) v2 - v32 = V.map (\t -> (snd t) / y6) v2 - v3 = V.zip v31 v32 - f1Tup (t1, w2) = V.imap (\ i (u1, u2) -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 - in V.map f1Tup (h1 . V.unsafeSlice x3 x4 $ v00) - --- | Generalized variant of the 'splitO2' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument. -splitOG2 :: (OvertonesO -> OvertonesO) -> String -> Int -> OvertonesO -> V.Vector OvertonesO -splitOG2 h xs n v0 - | compare (V.length v0) (n + 1) == GT = - let c1s = take 2 . filter isAsciiLower $ xs - v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - (x0, y0) = V.unsafeIndex v1 0 in - case c1s of - "ab" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,n - 1,V.length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) - "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,V.length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) - "ad" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) - _ -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) - | otherwise = V.singleton v0 - --- | Generalized variant of the 'splitOG1' with a possibility to specify a default value for splitting parameters as the first argument --- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order 'V.Vector' (the second one). --- Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. -splitOG12 :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> String -> Int -> OvertonesO -> V.Vector OvertonesO -splitOG12 (x1,x2,x3,x4) vf xs n v0 - | compare (V.length v0) (n + 1) == GT && not (V.null vf) = - let c1s = filter isAsciiLower $ xs - v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) vf) c1s in - splitHelp1 k1 k2 k3 k4 v1 (x0,y0) - | otherwise = V.singleton v0 - --- | Variant of the 'splitOG12' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument --- then it is better to use 'splitOG12'. Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. -splitOG12S :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> String -> Int -> OvertonesO -> V.Vector OvertonesO -splitOG12S (x1,x2,x3,x4) vf xs n v0 - | compare (V.length v0) (n + 1) == GT && not (V.null vf) = - let c1s = filter isAsciiLower $ xs - v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - v2 = V.fromList . sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) . V.toList $ vf - (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) v2) c1s in - splitHelp1 k1 k2 k3 k4 v1 (x0,y0) - | otherwise = V.singleton v0 - --- | Generalized variant of the 'splitOG2' with a possibility to specify a default value for splitting parameters as the first argument --- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order 'V.Vector' (the second one). --- Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. -splitOG22 :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> (OvertonesO -> OvertonesO) -> String -> Int -> - OvertonesO -> V.Vector OvertonesO -splitOG22 (x1,x2,x3,x4) vf h xs n v0 - | compare (V.length v0) (n + 1) == GT && not (V.null vf) = - let c1s = filter isAsciiLower $ xs - v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) vf) c1s in - splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) - | otherwise = V.singleton v0 - --- | Variant of the 'splitOG22' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument --- then it is better to use 'splitOG22'. Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. -splitOG22S :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> (OvertonesO -> OvertonesO) -> String -> Int -> - OvertonesO -> V.Vector OvertonesO -splitOG22S (x1,x2,x3,x4) vf h xs n v0 - | compare (V.length v0) (n + 1) == GT && not (V.null vf) = - let c1s = filter isAsciiLower $ xs - v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 - v2 = V.fromList . sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) . V.toList $ vf - (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) v2) c1s in - splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) - | otherwise = V.singleton v0 - --- | Concatenates a 'V.Vector' of 'OvertonesO' into a single 'OvertonesO'. Can be easily used with 'splitO'. -overConcat :: V.Vector OvertonesO -> OvertonesO -overConcat = V.concat . V.toList - ------------------------------------------------------------------------------------------------------------------- - --- | Function can be used to determine to which octave (in the American notation for the notes, this is a number in the note written form, --- e. g. for C4 this is 4) the frequency belongs (to be more exact, the closest note for the given frequency -- see 'closestNote' taking into account --- its lower pure quint, which can lay in the lower by 1 octave). If it is not practical to determine the number, then the function returns 'Nothing'. -whichOctave :: Double -> Maybe Int -whichOctave x - | compare (closestNote x) 24.4996 == GT = (\t -> - case isJust t of - True -> fmap (\z -> - case z of - 0 -> z - _ -> z - 1) t - _ -> Just 8) . V.findIndex (\(t1, t2) -> compare (closestNote x) t1 == LT) $ octavesT - | otherwise = Nothing - --- | Generalized version of the 'whichOctave'. -whichOctaveG :: Double -> Maybe Int -whichOctaveG x - | compare (closestNote x) (V.unsafeIndex notes 0) == GT && compare x (V.unsafeIndex notes 107) /= GT = (\t -> - case isJust t of - True -> fmap (\z -> - case z of - 0 -> z - _ -> z - 1) t - _ -> Just 8) . V.findIndex (\(t1, t2) -> compare (closestNote x) t1 == LT) $ octavesT - | otherwise = Nothing - --- | A way to get from a 'Params' a corresponding 'V.Vector' of 'Double' (if any) and so to work with them further. May contain some issues --- so please, before production usage check thoroughly. --- For information there were used the following: --- --- https://en.wikipedia.org/wiki/Mode_(music) --- --- https://en.wikipedia.org/wiki/Ukrainian_Dorian_scale --- --- https://en.wikipedia.org/wiki/List_of_musical_scales_and_modes --- --- https://en.wikipedia.org/wiki/Octatonic_scale --- --- several other articles in the English Wikipedia --- --- and in Ukrainian: --- Смаглій Г., Маловик Л. Теорія музики : Підруч. для навч. закл. освіти, культури і мистецтв / Г.А. Смаглій. -- Х. : Вид-во \"Ранок\", 2013. -- 392 с. --- ISBN 978-617-09-1294-7 --- -filterInParams :: Params -> Maybe (V.Vector Double) -filterInParams (P3lf n2 nL zs) -- generalized sound series, e. g. the chromatic ones etc. - | all (\n -> compare n 0 /= LT) ([nL,107 - nL - n2,n2 - 2] ++ zs) = - if V.null . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) i) $ - (V.unsafeSlice nL n2 notes) - then Nothing - else Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) i) - (V.unsafeSlice nL n2 notes)) - | otherwise = Nothing -filterInParams (P32sf nT n2 nL xs ys) -- dur and moll in various their modifications - | all (\n -> compare n 0 /= LT) [107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 12] = - case xs of - "dur" -> getBFst' (Nothing,V.fromList . zip ["DoubleH","H","Full","Full moll","M","N"] $ fmap Just - [V.ifilter (\i _ -> toneD i nL nT [2,3,6,8,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,3,5,9,10]) - (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,3,5]) - (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6]) - (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,3,5,9,11]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneD i nL nT [1,3,5,8,10]) (V.unsafeSlice nL n2 notes)]) ys - "moll" -> getBFst' (Nothing,V.fromList . zip ["DoubleH1","H","Full","Full dur","M","N"] $ fmap Just - [V.ifilter (\i _ -> toneD i nL nT [1,4,5,9,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,4,6,9,10]) - (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,4,6]) - (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6]) - (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,4,6,8,10]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneD i nL nT [1,4,6,9,11]) (V.unsafeSlice nL n2 notes)]) ys - _ -> Nothing - | otherwise = Nothing -filterInParams (P4lsf nT n2 nL zs xs) - | all (\n -> compare n 0 /= LT) ([107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 2] ++ zs) = - case xs of - "ditonic" -> - if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) $ (V.unsafeSlice nL n2 notes)) /= 2 - then Nothing - else - if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 2 . sortNoDup . filter (< n2) $ zs) $ - replicate n2 True) i) (V.unsafeSlice nL n2 notes)) - then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 2 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) (V.unsafeSlice nL n2 notes)) - else Nothing - "tritonic" -> - if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) $ (V.unsafeSlice nL n2 notes)) /= 3 - then Nothing - else - if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 3 . sortNoDup . filter (< n2) $ zs) $ - replicate n2 True) i) (V.unsafeSlice nL n2 notes)) - then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 3 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) (V.unsafeSlice nL n2 notes)) - else Nothing - "tetratonic" -> - if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) $ (V.unsafeSlice nL n2 notes)) /= 4 - then Nothing - else - if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 4 . sortNoDup . filter (< n2) $ zs) $ - replicate n2 True) i) (V.unsafeSlice nL n2 notes)) - then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 4 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) (V.unsafeSlice nL n2 notes)) - else Nothing - "octatonic" -> - if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) $ (V.unsafeSlice nL n2 notes)) /= 8 - then Nothing - else - if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 8 . sortNoDup . filter (< n2) $ zs) $ - replicate n2 True) i) (V.unsafeSlice nL n2 notes)) - then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 8 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) (V.unsafeSlice nL n2 notes)) - else Nothing - _ -> Nothing - | compare nL 0 /= LT && compare nL 107 /= GT && n2 == 1 && xs == "monotonic" = Just (V.singleton (V.unsafeIndex notes nL)) - | otherwise = Nothing -filterInParams (P2 nL n2) - | all (\n -> compare n 0 /= LT) [107 - nL - n2,nL,n2 - 2] = Just (V.unsafeSlice nL n2 notes) - | otherwise = Nothing -filterInParams (P2s nL n2 xs) - | all (\n -> compare n 0 /= LT) [107 - nL - n2,nL,n2 - 12] = - getBFst' (Nothing,V.fromList . zip ["Egyptian pentatonic", "Prometheus hexatonic scale", "Ukrainian Dorian scale", "augmented hexatonic scale", - "blues major pentatonic", "blues minor pentatonic", "blues scale", "major hexatonic scale", "major pentatonic", "minor hexatonic scale", - "minor pentatonic", "tritone hexatonic scale", "two-semitone tritone hexatonic scale", "whole tone scale"] $ map Just - [V.ifilter (\i _ -> toneE i nL nL [0,2,5,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,2,4,6,9,10]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneE i nL nL [0,2,3,6,7,9,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,4,7,8,11]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneE i nL nL [0,2,5,7,9]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,8,10]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneE i nL nL [0,3,5,6,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,6,7,10]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneE i nL nL [0,2,4,5,7,9]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,2,4,7,9]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneE i nL nL [0,2,3,5,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,7,10]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneE i nL nL [0,1,4,6,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,1,3,7,8,9]) (V.unsafeSlice nL n2 notes), - V.ifilter (\i _ -> toneE i nL nL [0,2,4,6,8,10]) (V.unsafeSlice nL n2 notes)]) xs - | otherwise = Nothing -filterInParams (P3sf nT nL n2 xs) - | all (\n -> compare n 0 /= LT) [101 - nL,nT,nL,nT - nL,nL + 6 - nT] && n2 == 6 = - case xs of - "Dorian tetrachord" -> - if (nT - nL) `elem` [0,1,3,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,1,3,5]) (V.unsafeSlice nL 6 notes)) else Nothing - "Phrygian tetrachord" -> - if (nT - nL) `elem` [0,2,3,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,2,3,5]) (V.unsafeSlice nL 6 notes)) else Nothing - "Lydian tetrachord" -> - if (nT - nL) `elem` [0,2,4,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,2,4,5]) (V.unsafeSlice nL 6 notes)) else Nothing - _ -> Nothing - | all (\n -> compare n 0 /= LT) [94 - nL,nT,nL,nT - nL,nL + 13 - nT] && n2 == 13 = - getBFst' (Nothing, V.fromList . zip ["modern Aeolian mode", "modern Dorian mode", "modern Ionian mode", "modern Locrian mode", - "modern Lydian mode", "modern Mixolydian mode", "modern Phrygian mode"] $ fmap (h3 nT n2 nL) [[1,4,6,9,11], [1,4,6,8,11], [1,3,6,8,10], - [2,4,7,9,11], [1,3,5,8,10], [1,3,6,8,11], [2,4,6,9,11]]) xs - | otherwise = Nothing - -h3 :: Int -> Int -> Int -> [Int] -> Maybe (V.Vector Double) -h3 nT n2 nL zs - | nT == nL = Just (V.ifilter (\i _ -> toneD i nL nT zs) (V.unsafeSlice nL n2 notes)) - | otherwise = Nothing - --- | For the list of @a@ from the @Ord@ class it builds a sorted in the ascending order list without duplicates. --- --- > sortNoDup [2,1,4,5,6,78,7,7,5,4,3,2,5,4,2,4,54,3,5,65,4,3,54,56,43,5,2] = [1,2,3,4,5,6,7,43,54,56,65,78] --- -sortNoDup :: Ord a => [a] -> [a] -sortNoDup = sortNoDup' . sort - where sortNoDup' (x:x1@(y:_)) - | x == y = sortNoDup' x1 - | otherwise = x:sortNoDup' x1 - sortNoDup' (x:_) = [x] - sortNoDup' _ = [] - --- | Checks whether its first 'Int' argument does not belong to those ones that are included into the list argument on the reminders basis. --- The opposite to 'toneE' with the same arguments. -toneD :: Int -> Int -> Int -> [Int] -> Bool -toneD i nL nT zs = getBFst' (True,V.fromList . zip zs $ replicate 12 False) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) - --- | Checks whether its first 'Int' argument does belong to those ones that are included into the list argument on the reminders basis. --- The opposite to 'toneD' with the same arguments. -toneE :: Int -> Int -> Int -> [Int] -> Bool -toneE i nL nT zs = getBFst' (False,V.fromList . zip zs $ replicate 12 True) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) - --- | Analogous to 'liftInEnku' lifts a frequency into a tonality (or something that can be treated alike one) specified by 'Params'. If not --- reasonably one exists then the result is 11440 (Hz). -liftInParams :: Double -> Params -> Double -liftInParams x params - | lengthP params == 0 || (isNothing . whichOctaveG $ x) = 11440.0 - | otherwise = - V.unsafeIndex (fromJust . filterInParams $ params) (V.minIndex . V.map (abs . log . (\t -> t / x)) . V.generate (lengthP params) $ - (\i -> V.unsafeIndex notes (12 * fromJust (whichOctaveG x)) * 2 ** (fromIntegral i / fromIntegral (lengthP params)))) - --- | Application of the 'liftInParams' to a 'V.Vector'. -liftInParamsV :: Params -> V.Vector Double -> V.Vector Double -liftInParamsV params = V.filter (/= 11440.0) . V.map (\x -> liftInParams x params) - --- | Gets a length of the 'V.Vector' of 'Double' being represented as 'Params'. This is a number of the notes contained in the 'Params'. -lengthP :: Params -> Int -lengthP = fromMaybe 0 . fmap V.length . filterInParams - --- | Check whether a given 'Double' value (frequency of a note) is in the vector of Doubles that corresponds to the given 'Params'. -elemP :: Double -> Params -> Bool -elemP note = fromMaybe False . fmap (note `V.elem`) . filterInParams - --- | Check whether a given 'Double' value (frequency of the closest note to the given frequency) is in the vector of Doubles that --- corresponds to the given 'Params'. -elemCloseP :: Double -> Params -> Bool -elemCloseP note = fromMaybe False . fmap (closestNote note `V.elem`) . filterInParams - --- | A way to show not the (somewhat algebraic) structure of the 'Params' (as the usual 'show' does), but the contained frequencies in it. -showD :: Params -> String -showD = show . filterInParams - ------------------------------------------------------------------------------------------------- - --- | Tesing variant of the 'soundGen3G' with predefined three last functional arguments. -testSoundGen2G :: FilePath -> (Double -> OvertonesO) -> Double -> String -> IO () - ---------------------- - -- f -testSoundGen2G = testSoundGen2GMN (-1) (-1) - --- | Tesing variant of the 'soundGen3GMN' with predefined three last functional arguments. -testSoundGen2GMN :: Int64 -> Int64 -> FilePath -> (Double -> OvertonesO) -> Double -> String -> IO () - ---------------------- - -- f -testSoundGen2GMN m n1 file f y zs = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m n1) file) -- >>= print - let n = V.length vecA0 - freq0 j = V.unsafeIndex notes (snd . V.unsafeIndex vecA0 $ j `rem` n) - f0 t = V.fromList [(0.05763181818181818 * t, 0.3598),(1.112159090909091 * t, 0.4588962),(2 * t, 0.6853),(3 * t, 0.268),(4 * t, 0.6823),(5 * t, 0.53)] - fA1 j = fAddFElem (freq0 (j + 1),0.5) f0 gAdd04 - fR1 j = fRemoveFElem (freq0 (j + 1),0.5) f0 gRem03 - vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r), - case fst r of - 0 -> f0 - 1 -> fA1 j - 2 -> fA1 j - 3 -> fA1 j - 4 -> fA1 j - _ -> fR1 j)) vecA0 - v2 = str2DurationsDef n zs y - zeroN = numVZeroesPre vecB in V.imapM_ (\j (x,k) -> do - h1 (\u -> k (1.1 * freq0 j)) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generates a sequence of sounds with changing timbre. Uses several functions as parameters. -soundGen3G :: FilePath -> (Double -> OvertonesO) -> Double -> String -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) - -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G = soundGen3GMN (-1) (-1) - --- | Generates a sequence of sounds with changing timbre. Uses several functions as parameters. To specify how many sounds the resulting files --- will provide, you use first two 'Int64' arguments, the first of which is a number of dropped elements for 'readFileDoubles' and the second one --- is a number of produced sounds (and, respectively, number of taken elements). -soundGen3GMN :: Int64 -> Int64 -> FilePath -> (Double -> OvertonesO) -> Double -> String -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) - -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3GMN m n1 file f y zs gAdd gRem f0 = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m n1) file) -- >>= print - let n = V.length vecA0 - freq0 j = V.unsafeIndex notes (snd . V.unsafeIndex vecA0 $ j `rem` n) - fA1 j = fAddFElem (freq0 (j + 1),0.5) f0 gAdd - fR1 j = fRemoveFElem (freq0 (j + 1),0.5) f0 gRem - vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r), - case fst r of - 0 -> f0 - 1 -> fA1 j - 2 -> fA1 j - 3 -> fA1 j - 4 -> fA1 j - _ -> fR1 j)) vecA0 - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do - h1 (\u -> k (1.1 * freq0 j)) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generates a sequence of sounds with changing timbre. Uses several functions as parameters. Unlike the 'soundGen3G', the last two --- functions as arguments for their first argument have not ('Double','Double'), but 'V.Vector' of them so are applied to 'OvertonesO'. To --- provide a generalized functionality, it uses two additional functions @freq0 :: Int -> OvertonesO@ and @proj :: OvertonesO -> OvertonesO@ --- to define the first element to which are applied @gAdds@ and @gRems@ and the way to obtain a internal 'OvertonesO'. --- Besides, it lifts notes into specified with the first two 'Int' arguments enku (see 'liftInEnku'). --- The 'Double' argument is a average duration of the sounds. -soundGen3G_O :: Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) - -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> - (Double -> OvertonesO) -> IO () -soundGen3G_O = soundGen3G_OMN (-1) (-1) - --- | Generalized version of the 'soundGen3G_O' where 'liftInParams' is used instead of lifting with the 'liftInEnku'. This allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -soundGen3G_OPar :: Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) - -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> - (Double -> OvertonesO) -> IO () -soundGen3G_OPar = soundGen3G_OMNPar (-1) (-1) - --- | Generates a sequence of sounds with changing timbre. Uses several functions as parameters. To specify how many sounds the resulting files --- will provide, you use first two 'Int64' arguments, the first of which is a number of dropped elements for 'readFileDoubles' and the second one --- is a number of produced sounds (and, respectively, number of taken elements). -soundGen3G_OMN :: Int64 -> Int64 -> Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) - -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> - (Double -> OvertonesO) -> IO () -soundGen3G_OMN m1 n1 m ku freq1 file f y zs gAdds gRems freq0 proj f0 = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file) -- >>= print - let n = V.length vecA0 - fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds - fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems - vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r), - case fst r of - 0 -> f0 - 1 -> fA1 j - 2 -> fA1 j - 3 -> fA1 j - 4 -> fA1 j - _ -> fR1 j)) vecA0 - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do - h2 (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) m ku freq1 - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generalized version of the 'soundGen3G_OMN' where 'liftInParams' is used instead of lifting with the 'liftInEnku'. This allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -soundGen3G_OMNPar :: Int64 -> Int64 -> Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) - -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> - (Double -> OvertonesO) -> IO () -soundGen3G_OMNPar m1 n1 params freq1 file f y zs gAdds gRems freq0 proj f0 = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file) -- >>= print - let n = V.length vecA0 - fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds - fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems - vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r), - case fst r of - 0 -> f0 - 1 -> fA1 j - 2 -> fA1 j - 3 -> fA1 j - 4 -> fA1 j - _ -> fR1 j)) vecA0 - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do - h2Params (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) params freq1 - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generates a sequence of sounds with changing timbre. Is a generalized version of the 'soundGen3G_O', instead of predefined conversion function --- inside, it uses a user-defined one. --- --- > soundGen3G_O = soundGen3G_O2 --- with the first argument --- --- > conversionFII (f0,fA1,fR1) = imap (\j r -> (unsafeIndex notes (snd r), --- --- > case fst r of --- --- > 0 -> f0 --- --- > 1 -> fA1 j --- --- > 2 -> fA1 j --- --- > 3 -> fA1 j --- --- > 4 -> fA1 j --- --- > _ -> fR1 j)) --- --- -soundGen3G_O2 :: ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2 = soundGen3G_O2MN (-1) (-1) - --- | Generalized version of the 'soundGen3G_O2' where 'liftInParams' is used instead of lifting with the 'liftInEnku'. This allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -soundGen3G_O2Par :: ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2Par = soundGen3G_O2MNPar (-1) (-1) - --- | Generates a sequence of sounds with changing timbre. Is a generalized version of the 'soundGen3G_O2'. To specify how many sounds the resulting files --- will provide, you use first two 'Int64' arguments, the first of which is a number of dropped elements for 'readFileDoubles' and the second one --- is a number of produced sounds (and, respectively, number of taken elements). -soundGen3G_O2MN :: Int64 -> Int64 -> ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2MN m1 n1 conversionFII m ku freq1 file f y zs gAdds gRems freq0 proj f0 = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file) -- >>= print - let n = V.length vecA0 - fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds - fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems - vecB = conversionFII (f0,fA1,fR1) vecA0 - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do - h2 (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) m ku freq1 - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generalized version of the 'soundGen3G_O2MN' where 'liftInParams' is used instead of lifting with the 'liftInEnku'. This allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -soundGen3G_O2MNPar :: Int64 -> Int64 -> ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2MNPar m1 n1 conversionFII params freq1 file f y zs gAdds gRems freq0 proj f0 = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file) -- >>= print - let n = V.length vecA0 - fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds - fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems - vecB = conversionFII (f0,fA1,fR1) vecA0 - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do - h2Params (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) params freq1 - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generates a sequence of sounds with changing timbre. Is a generalized version of the 'soundGen3G_O2', but for the conversion function conversionFII as its --- tuple first argument uses not the tuple of the three functions, but a tuple of three 'V.Vector' of functions of the respective types, that allows to --- specify more comlex behaviour and different variants inside the function itself, not its inner function parts. 'V.Vector' as a data type is used --- instead of more common list because it has similar functionality and besides provides easier and quicker access to its elements. So these are the --- following vectors of functions: @vf :: Vector (Double -> OvertonesO)@ (no changing a function for timbre generation), --- @vfA :: Vector (Int -> Double -> OvertonesO)@ (for \"adding\" overtones to the function for timbre generation), --- and @vfR :: Vector (Int -> Double -> OvertonesO@ (for \"removing\" overtones from the function for timbre generation). --- -soundGen3G_O2G :: ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> - Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2G = soundGen3G_O2GMN (-1) (-1) - --- | Generalized version of the 'soundGen3G_O2G' where 'liftInParams' is used instead of lifting with the 'liftInEnku'. This allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -soundGen3G_O2GPar :: ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> - Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2GPar = soundGen3G_O2GMNPar (-1) (-1) - --- | Generates a sequence of sounds with changing timbre. Is a generalized version of the 'soundGen3G_O2G'. To specify how many sounds the resulting files --- will provide, you use first two 'Int64' arguments, the first of which is a number of dropped elements for 'readFileDoubles' and the second one --- is a number of produced sounds (and, respectively, number of taken elements). -soundGen3G_O2GMN :: Int64 -> Int64 -> ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> - Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2GMN m1 n1 conversionFII vf vfA vfR m ku freq1 file f y zs gAdds gRems freq0 f0 = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file) -- >>= print - let n = V.length vecA0 - vecB = conversionFII (vf,vfA,vfR) vecA0 - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do - h2 (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) m ku freq1 - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | Generalized version of the 'soundGen3G_O2GMN' where 'liftInParams' is used instead of lifting with the 'liftInEnku'. This allows e. g. to --- use some tonality. For more information, please, refer to 'filterInParams'. -soundGen3G_O2GMNPar :: Int64 -> Int64 -> ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) -> - V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> - Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> - (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> - (Int -> OvertonesO) -> (Double -> OvertonesO) -> IO () -soundGen3G_O2GMNPar m1 n1 conversionFII vf vfA vfR params freq1 file f y zs gAdds gRems freq0 f0 = do - vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file) -- >>= print - let n = V.length vecA0 - vecB = conversionFII (vf,vfA,vfR) vecA0 - zeroN = numVZeroesPre vecB - v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do - h2Params (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) params freq1 - renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB - endFromResult - --- | For the given parameters generates a single sound with overtones or pause depending on the sign of the second element in the tuple of 'Double': --- if it is greater than zero then the sound is generated, if less -- the silence (pause), if it is equal to zero then it prints an informational message --- about a non-standard situation. -h1 :: (Double -> OvertonesO) -> (Double, Double) -> Int -> IO () -h1 f (x, y) j = do - let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - v0 = f note0 - ts = showFFloat (Just 4) (abs y) "" - case compare y 0.0 of - GT -> do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] "" - print herr - partialTest_k v0 0 ts - mixTest - LT -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing note0 "","vol","0"] "" >>= - \(_,_,herr) -> putStr herr - _ -> putStrLn "Zero length of the sound! " - --- | For the given parameters generates a single sound with overtones or pause depending on the sign of the second element in the tuple of 'Double': --- if it is greater than zero then the sound is generated, if less -- the silence (pause), if it is equal to zero then it prints an informational message --- about a non-standard situation. Unlike the 'h1' function, it lifts the frequency into the enku specified by the 'Int' arguments (see 'liftInEnku'). -h2 :: OvertonesO -> (Double, Double) -> Int -> Int -> Double -> IO () -h2 v (x, y) m ku freq1 = do - let note0 = fromMaybe freq1 . liftInEnku m ku . closestNote $ (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - ts = showFFloat (Just 4) (abs y) "" - case compare y 0.0 of - GT -> do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] "" - print herr - partialTest_k v 0 ts - mixTest - LT -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing note0 "","vol","0"] "" >>= - \(_,_,herr) -> putStr herr - _ -> putStrLn "Zero length of the sound! " - --- | For the given parameters generates a single sound with overtones or pause depending on the sign of the second element in a tuple of 'Double': --- if it is greater than zero then the sound is generated, if less -- the silence (pause), if it is equal to zero then it prints an informational message --- about a non-standard situation. Unlike the 'h1' function, it lifts into the requency specified by the 'Params' argument . -h2Params :: OvertonesO -> (Double, Double) -> Params -> Double -> IO () -h2Params v (x, y) params freq1 = do - let note01 = flip liftInParams params (if x /= 0.0 then abs x else V.unsafeIndex notes 0) - ts = showFFloat (Just 4) (abs y) "" - note0 = if note01 == 11440.0 then freq1 else note01 - case compare y 0.0 of - GT -> do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] "" - print herr - partialTest_k v 0 ts - mixTest - LT -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing note0 "","vol","0"] "" >>= - \(_,_,herr) -> putStr herr - _ -> putStrLn "Zero length of the sound! " - --- | Generates melody for the given parameters. The idea is that every application of the function @f :: Double -> OvertonesO@ to its argument --- possibly can produce multiple overtones being represented as 'V.Vector' of tuples of pairs of 'Double'. We can use the first element in the --- tuple to obtain a new sound parameters and the second one -- to obtain its new duration in the melody. Additional function @g :: Double -> Double@ --- is used to avoid the effect of becoming less and less -- closer to the zero for the higher overtones so the durations will become also less. --- Besides it allows to rescale the durations in a much more convenient way. --- --- The first 'Double' parameter is a multiplication coefficient to increase or to decrease the durations (values with an absolute values greater than --- one correspond to increasing inside the @g@. function applied afterwards with function composition and the values with an absolute values less --- than one and not equal to zero correspond to decreasing inside the @g@ function. --- The second 'Double' parameter is a usual frequency which is used instead of the 11440.0 (Hz) value. --- The third 'Double' parameter is a main argument -- the frequency for which the 'OvertonesO' are generated as a first step of the computation. -overMeloPar :: (Double -> OvertonesO) -> (Double -> Double) -> Params -> Double -> Double -> Double -> IO () -overMeloPar f g params coeff freq0 freq = do - let v = f freq - vFreqs = V.map ((\z -> if z == 11440.0 then freq0 else z) . flip liftInParams params . fst) v - vD = V.map (g . (* coeff) . snd) v - v2 = V.map f vFreqs - vS = V.map (\z -> showFFloat (Just 4) (abs z) "") vD - h42 j (x,v3,y,ts) - | compare y 0.0 == GT = do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing (fst x) ""] "" - print herr - partialTest_k v3 0 ts - mixTest - renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav" - | compare y 0.0 == LT = do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"] "" - putStr herr - renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav" - | otherwise = putStrLn "Zero length of the sound! " - V.imapM_ (\j zz -> h42 j zz) . V.zip4 v v2 vD $ vS - --- | Check whether for the given arguments there are the notes and whether 'String' is a name signature for the scale in 'Params' (can they be used --- together to correspond to a non-empty set of notes). -isStrParams :: String -> Params -> Bool -isStrParams xs (P2s x y zs) = if isJust (filterInParams (P2s x y zs)) then xs == zs else False -isStrParams xs (P3sf x y z zs) = if isJust (filterInParams (P3sf x y z zs)) then xs == zs else False -isStrParams xs (P4lsf x y z ts zs) = if isJust (filterInParams (P4lsf x y z ts zs)) then xs == zs else False -isStrParams xs (P32sf x y z zs ys) = if isJust (filterInParams (P32sf x y z zs ys)) then (xs == zs || xs == ys || xs == (ys ++ " " ++ zs)) else False -isStrParams _ _ = False - --- | Check whether for the given arguments there are the notes and whether list of 'Int' is a part of the constructed 'Params' (can they be used --- together to correspond to a non-empty set of notes). -isListParams :: [Int] -> Params -> Bool -isListParams xs (P4lsf x y z ts zs) = if isJust (filterInParams (P4lsf x y z ts zs)) then xs == ts else False -isListParams xs (P3lf x y zs) = if isJust (filterInParams (P3lf x y zs)) then xs == zs else False -isListParams _ _ = False + -- * Use additional function as a parameter + overSoXSynth2FDN + , overSoXSynth2FDN_B + -- ** Just simple function application + , overSoXSynth2FDN_S + -- *** With additional filtering + , overSoXSynth2FDN_Sf + , overSoXSynth2FDN_Sf3 + -- * Use additional function and Ukrainian texts and generates melody + , overSoXSynthGen2FDN + , overSoXSynthGen2FDN_B + , overSoXSynthGen2FDN_S + , overSoXSynthGen2FDN_Sf + , overSoXSynthGen2FDN_Sf3 + -- * 1G generalized functions with dB volume overtones adjustments + , overSoXSynth2FDN1G + , overSoXSynth2FDN_B1G + , overSoXSynth2FDN_S1G + , overSoXSynth2FDN_Sf1G + , overSoXSynth2FDN_Sf31G + -- * 2G generalized functions with additional sound quality specifying + , overSoXSynth2FDN2G + , overSoXSynth2FDN_B2G + , overSoXSynth2FDN_S2G + , overSoXSynth2FDN_Sf2G + , overSoXSynth2FDN_Sf32G + -- ** 2G generalized functions for melody producing + , overSoXSynthGen2FDN_SG2G + , overSoXSynthGen2FDN_Sf3G2G + -- * Generalized functions with several functional parameters + , soundGenF3 + , overSoXSynthGen2FDN_SG + , overSoXSynthGen2FDN_Sf3G + -- ** 1G generalized function with db volume overtones adjustments and several functional parameters + , soundGenF31G + -- * New functions for the version 0.36.0.0 + , overSoXSynthGen2FDN4G + , overSoXSynthGen2FDN_SG4G + , overSoXSynthGen2FDN_SG4GS + -- * New generalized 5G functions that works with Intervals + , overSoXSynth2FDN5G + , overSoXSynth2FDN_B5G + , overSoXSynth2FDN_S5G + , overSoXSynth2FDN_Sf35G + -- * New generalized 6G functions that works with Strengths + , overSoXSynth2FDN6G + , overSoXSynth2FDN6GS + , overSoXSynth2FDN_B6G + , overSoXSynth2FDN_B6GS + , overSoXSynth2FDN_S6G + , overSoXSynth2FDN_S6GS + , overSoXSynth2FDN_Sf36G + , overSoXSynth2FDN_Sf36GS + , overSoXSynthGen2FDN_SG6G + , overSoXSynthGen2FDN_SG6GS + , overSoXSynthGen2FDN_SG6GSu +) where + +import Numeric +import Data.List (nubBy) +import Data.Maybe (isNothing,fromJust,fromMaybe,maybe) +import qualified Data.Vector as V +import System.Process +import EndOfExe +import System.Directory +import Melodics.Ukrainian (convertToProperUkrainian) +import DobutokO.Sound.IntermediateF +import DobutokO.Sound.Functional.Basics +import DobutokO.Sound.Functional.Params +import DobutokO.Sound.DIS5G6G (intervalsFromStringG,str2Durations,str2Vol1,str2Volume) + +-- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with +-- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is an experimental feature, so +-- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the +-- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. 'Int' argument is an index of the element to be taken from +-- the 'intervalsFromString' applied to the 'String' argument. To obtain compatible with versions prior to 0.20.0.0 behaviour, use for the 'Int' 0. +-- +-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. +-- But for a lot of functions this works well. +-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN'. +overSoXSynth2FDN :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO () +overSoXSynth2FDN f (x, y) j zs = overSoXSynth2FDN1G f (x, y) j zs (V.replicate (V.length . f . closestNote $ if x /= 0.0 + then abs x else V.unsafeIndex notes 0) 0.0) + +-- | 'V.Vector' of 'Double' is a vector of dB volume adjustments for the corresponding harmonices (overtones). +overSoXSynth2FDN1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () +overSoXSynth2FDN1G f (x, y) j zs vdB = overSoXSynth2FDN2G f (x, y) j zs vdB [] + +-- | Similar to 'overSoXSynth2FDN1G', but additionally allows to specify by the second 'String' argument a quality changes to the generated files +-- (please, see 'soxBasicParams'). Since version 0.36.0.0 the function supports generation of the pauses. +overSoXSynth2FDN2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN2G f (x, y) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = length zs + note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k + v0 = g note0 + v1 = maybe V.empty g note1 + ts = showFFloat (Just 4) (abs y) "" + overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") + overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "","vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"] (V.unsafeIndex vdB i))) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts, + "sine", showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts, + "sine", showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + if null ys then mixTest else mixTest2G ys + +-- | Similar to 'overSoXSynth2FDN2G', but additionally allows to specify by the 'Intervals' argument to specify your own intervals. For more information, +-- please, refer to 'intervalsFromStringG'. +overSoXSynth2FDN5G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () +overSoXSynth2FDN5G f (x, y) j v5 vdB ys + | V.null v5 = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = V.length v5 + note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k + v0 = g note0 + v1 = maybe V.empty g note1 + ts = showFFloat (Just 4) (abs y) "" + overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") + overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "","vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"] (V.unsafeIndex vdB i))) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts, + "sine", showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts, + "sine", showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + if null ys then mixTest else mixTest2G ys + +-- | Generalized variant of the 'overSoXSynth2FDN5G' with afterwards 'apply6Gf' usage. +overSoXSynth2FDN6G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () +overSoXSynth2FDN6G f (x, y) j v5 vdB ys vol + | V.null v5 = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = V.length v5 + note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k + v0 = g note0 + v1 = maybe V.empty g note1 + ts = showFFloat (Just 4) (abs y) "" + overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") + overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "","vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"] (V.unsafeIndex vdB i))) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts, + "sine", showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts, + "sine", showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + if null ys then mixTest else mixTest2G ys + if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" + +-- | A variant of the 'overSoXSynth2FDN6G' where volume adjustment is obtained from a Ukrainian text. +overSoXSynth2FDN6GS :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () +overSoXSynth2FDN6GS f (x, y) j v5 xs vdB ys xxs + | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " + | otherwise = overSoXSynth2FDN6G f (x, y) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) + +-- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set +-- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12. +-- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. A 'Double' parameter is a +-- basic sound duration, it defines tempo of the melody in general. +overSoXSynthGen2FDN :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () +overSoXSynthGen2FDN file m ku f y zs wws = overSoXSynthGen2FDN_SG file m ku f y zs wws overSoXSynth2FDN + +-- | Generalized variant of the 'overSoXSynthGen2FDN' with your own specified 'Durations' for the sounds and pauses. +-- Instead of using a Ukrainian text to specify a durations for the sounds (and a rhythm +-- respectively) you provide your own rhythm as 'Durations'. Positive values correspond to durations of the sounds generated +-- and negative values -- to durations of the pauses respectively. +overSoXSynthGen2FDN4G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Durations -> String -> IO () +overSoXSynthGen2FDN4G file m ku f v2 wws = overSoXSynthGen2FDN_SG4G file m ku f v2 wws overSoXSynth2FDN + +-- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with +-- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is experimental feature, so +-- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the +-- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. The function also tries to perform filtering to avoid possible beating. +-- The third 'Double' parameter in the tuple is used as a limit for frequencies difference in Hz to be filtered out from the resulting sound. It is +-- considered to be from the range @[0.1..10.0]@. An 'Int' parameter is used to define the needed interval. To obtain compatible with versions prior +-- to 0.20.0.0 behaviour, use for the 'Int' 0. +-- +-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. +-- But for a lot of functions this works well. +-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_B'. +overSoXSynth2FDN_B :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO () +overSoXSynth2FDN_B f (x, y, limB) j zs = overSoXSynth2FDN_B1G f (x, y, limB) j zs (V.replicate (V.length . f . closestNote $ if x /= 0.0 then abs x else V.unsafeIndex notes 0) 0.0) + +-- | 'V.Vector' of 'Double' is a vector of dB volume adjustments for the corresponding harmonices (overtones). +overSoXSynth2FDN_B1G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> IO () +overSoXSynth2FDN_B1G f (x, y, limB) j zs vdB = overSoXSynth2FDN_B2G f (x, y, limB) j zs vdB [] + +-- | Generalized version of the 'overSoXSynth2FDN_B1G' with a possibility to specify sound quality parameters using additional second 'String' +-- argument. For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_B2G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_B2G f (x, y, limB) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10 + limA = if compare limA0 0.1 == LT then 0.1 else limA0 + l0 = length zs + note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + v0 = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 note0) $ 0), z0)) . g0 $ note0 + v1 = if isNothing note1 then V.empty + else V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 . fromJust $ note1) $ 0), z0)) . g0 . fromJust $ note1 + ts = showFFloat (Just 4) (abs y) "" + overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") + overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) + ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "", "vol", + if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"])) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", + showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", + showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + if null ys then mixTest else mixTest2G ys + +-- | Generalized version of the 'overSoXSynth2FDN_B2G' with a possibility to specify your own 'Intervals'. For more information, please, +-- refer to 'intervalsFromStringG'. +overSoXSynth2FDN_B5G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_B5G f (x, y, limB) j v5 vdB ys + | V.null v5 = overSoXSynth x + | otherwise = do + let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10 + limA = if compare limA0 0.1 == LT then 0.1 else limA0 + l0 = V.length v5 + note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + v0 = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 note0) $ 0), z0)) . g0 $ note0 + v1 = if isNothing note1 then V.empty + else V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 . fromJust $ note1) $ 0), z0)) . g0 . fromJust $ note1 + ts = showFFloat (Just 4) (abs y) "" + overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") + overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) + ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "", "vol", + if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"])) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", + showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", + showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + if null ys then mixTest else mixTest2G ys + +-- | Generalized variant of the 'overSoXSynth2FDN_B5G' with afterwards 'apply6G' usage. +overSoXSynth2FDN_B6G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () +overSoXSynth2FDN_B6G f (x, y, limB) j v5 vdB ys vol + | V.null v5 = overSoXSynth x + | otherwise = do + let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10 + limA = if compare limA0 0.1 == LT then 0.1 else limA0 + l0 = V.length v5 + note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 + g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) -> + if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX, + abs (amplX - (fromIntegral . truncate $ amplX)))) . f + v0 = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 note0) $ 0), z0)) . g0 $ note0 + v1 = if isNothing note1 then V.empty + else V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . + V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 . fromJust $ note1) $ 0), z0)) . g0 . fromJust $ note1 + ts = showFFloat (Just 4) (abs y) "" + overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", + showFFloat Nothing noteN "", "vol", if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"]) "") + overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) + ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "", "vol", + if compare y 0.0 == GT then showFFloat Nothing amplN "" else "0"])) "") vec + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", + showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then overSoXSynthHelp v0 + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", + showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 vdB + if null ys then mixTest else mixTest2G ys + if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" + +-- | A variant of the 'overSoXSynth2FDN_B6G' where volume adjustment is obtained from a Ukrainian text. +overSoXSynth2FDN_B6GS :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () +overSoXSynth2FDN_B6GS f (x, y, limB) j v5 xs vdB ys xxs + | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " + | otherwise = overSoXSynth2FDN_B6G f (x, y, limB) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) + +-- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set +-- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12. +-- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. The first 'Double' parameter is a +-- basic sound duration, it defines tempo of the melody in general. The second one is a limit for frequencies difference in Hz to be filtered out from the +-- resulting sound. It is considered to be from the range @[0.1..10.0]@. +overSoXSynthGen2FDN_B :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> IO () +overSoXSynthGen2FDN_B file m ku f y limB zs wws = overSoXSynthGen2FDN_Sf3G file m ku f y limB zs wws overSoXSynth2FDN_B + +-- | Similar to 'overSoXSynth2FDN' but it does not make any normalizing transformations with the 'V.Vector' argument. To be used properly, it is needed +-- that every second element in the tuple in the 'V.Vector' argument must be in the range [-1.0..1.0] and every first element must be in between +-- 16.351597831287414 and 7902.132820097988 (Hz). An 'Int' parameter is used to define an interval. To obtain compatible with versions prior to +-- 0.20.0.0 behaviour, use for the 'Int' 0. +-- +-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. +-- But for a lot of functions this works well. +-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_S'. +overSoXSynth2FDN_S :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO () +overSoXSynth2FDN_S f (x, y) j zs = overSoXSynth2FDN_S2G f (x, y) j zs V.empty [] + +-- | Generalized version of the 'overSoXSynth2FDN_S' with the additional volume adjustment in dB for overtones given by 'V.Vector' of 'Double'. +overSoXSynth2FDN_S1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () +overSoXSynth2FDN_S1G f (x, y) j zs vdB = overSoXSynth2FDN_S2G f (x, y) j zs vdB [] + +-- | Generalized version of the 'overSoXSynth2FDN_S1G' with a possibility to specify sound quality parameters using the second 'String' argument. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_S2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_S2G f (x, y) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = length zs + note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0 + v0 = f note0 + v1 = maybe V.empty f note1 + ts = showFFloat (Just 4) (abs y) "" + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", + showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then partialTest_k2G v0 0 ts vdB ys + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", + showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + partialTest_k2G v0 0 ts vdB ys + partialTest_k2G v1 1 ts vdB ys + if null ys then mixTest else mixTest2G ys + +-- | Generalized version of the 'overSoXSynth2FDN_S2G' where you specify your own 'Intervals'. For more information, please, refer +-- to 'intervalsFromStringG'. +overSoXSynth2FDN_S5G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_S5G f (x, y) j v5 vdB ys + | V.null v5 = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = V.length v5 + note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 + v0 = f note0 + v1 = maybe V.empty f note1 + ts = showFFloat (Just 4) (abs y) "" + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", + showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then partialTest_k2G v0 0 ts vdB ys + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", + showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + partialTest_k2G v0 0 ts vdB ys + partialTest_k2G v1 1 ts vdB ys + if null ys then mixTest else mixTest2G ys + +-- | Generalized variant of the 'overSoXSynth2FDN_S5G' with afterwards 'apply6G' usage. Arguments for the latter is the three last function arguments. +overSoXSynth2FDN_S6G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () +overSoXSynth2FDN_S6G f (x, y) j v5 vdB ys vol + | V.null v5 = overSoXSynth x + | otherwise = do + let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0) + l0 = V.length v5 + note1 = dNote (V.unsafeIndex v5 (abs (j `rem` l0))) note0 + v0 = f note0 + v1 = maybe V.empty f note1 + ts = showFFloat (Just 4) (abs y) "" + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", + showFFloat Nothing note0 "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + if isNothing note1 then partialTest_k2G v0 0 ts vdB ys + else do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", + showFFloat Nothing (fromJust note1) "","vol", if compare y 0.0 == GT then "1.0" else "0"]) "" + partialTest_k2G v0 0 ts vdB ys + partialTest_k2G v1 1 ts vdB ys + if null ys then mixTest else mixTest2G ys + if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" + +-- | A variant of the 'overSoXSynth2FDN_S6G' where volume adjustment is obtained from a Ukrainian text. +overSoXSynth2FDN_S6GS :: (Double -> OvertonesO) -> (Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () +overSoXSynth2FDN_S6GS f (x, y) j v5 xs vdB ys xxs + | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " + | otherwise = overSoXSynth2FDN_S6G f (x, y) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) + +-- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. Note that the first '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@. +overSoXSynthGen2FDN_SG :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () +overSoXSynthGen2FDN_SG file m ku f y zs wws h = do + n <- duration1000 file + overSoXSynthGen2FDN_SG4G file m ku f (str2DurationsDef n zs y) wws h + +-- | Generalized version of the 'overSoXSynthGen2FDN_SG' where instead of using a Ukrainian text to specify a durations for the sounds (and a rhythm +-- respectively) you provide your own rhythm as 'Durations'. Positive values correspond to durations of the sounds generated +-- and negative values -- to durations of the pauses respectively. Please, use a function @h :: ((Double -> OvertonesO) -> (Double, Double) -> +-- Int -> String -> IO ())@ such that it can create for the given values accorgingly sounds and pauses. Otherwise, please, check whether at +-- least it can deal with such arguments without errors. 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@. +overSoXSynthGen2FDN_SG4G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Durations -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () +overSoXSynthGen2FDN_SG4G file m ku f v2 wws h = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB + endFromResult + +-- | A variant of the 'overSoXSynthGen2FDN_SG4G' where instead of providing your own durations as 'Durations' you use a Ukrainian text and +-- a function treats each symbol in it as a duration parameter with its sign. Positive values correspond to durations of the sounds generated +-- and negative values -- to durations of the pauses respectively. Please, use a function @h :: ((Double -> OvertonesO) -> (Double, Double) -> +-- Int -> String -> IO ())@ such that it can create for the given values accorgingly sounds and pauses. Otherwise, please, check whether at +-- least it can deal with such arguments without errors. +overSoXSynthGen2FDN_SG4GS :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () +overSoXSynthGen2FDN_SG4GS file m ku f y zs = overSoXSynthGen2FDN_SG4G file m ku f (str2Durations zs y) + +-- | 6G generalized variant of the 'overSoXSynthGen2FDN_SG4G' with volume adjustments given by '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@. +overSoXSynthGen2FDN_SG6G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Durations -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Strengths -> Double -> IO () +overSoXSynthGen2FDN_SG6G file m ku f v2 wws h v6 limV + | V.null v6 = putStrLn "You did not provide a volume adjustments vector! " + | otherwise = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav" + apply6GSilentFile ("result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") limV (V.unsafeIndex v6 (j `rem` V.length v6))) vecB + endFromResult + +-- | A variant of the 'overSoXSynthGen2FDN_SG6G' where 'Strengths' are obtained from a Ukrainian text and 'str2Volume'. +overSoXSynthGen2FDN_SG6GS :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> String -> Double -> IO () +overSoXSynthGen2FDN_SG6GS file m ku f y zs wws h zzs = overSoXSynthGen2FDN_SG6G file m ku f (str2Durations zs y) wws h (str2Volume zzs) + +-- | A variant of the 'overSoXSynthGen2FDN_SG6GS' where 'Strengths' are obtained from the same Ukrainian text as also 'Durations' so the last +-- 'String' argument is omitted (it is equal to the first one). Helps to create a speech-like composition. +overSoXSynthGen2FDN_SG6GSu :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Double -> IO () +overSoXSynthGen2FDN_SG6GSu file m ku f y zs wws h = overSoXSynthGen2FDN_SG6G file m ku f (str2Durations zs y) wws h (str2Volume zs) + +-- | Generalized variant of the 'overSoXSynthGen2FDN_SG' with a possibility to specify with the third 'String' argument sound quality parameters. +-- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. +-- For more information, please, refer to 'soxBasicParams'. 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@. +overSoXSynthGen2FDN_SG2G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) -> + (Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () +overSoXSynthGen2FDN_SG2G file m ku f y zs wws h ys = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws ys + renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ + if drop 3 ys == "f" then ".flac" else ".wav") vecB + endFromResult2G ys + +-- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. +overSoXSynthGen2FDN_S :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () +overSoXSynthGen2FDN_S file m ku f y zs wws = overSoXSynthGen2FDN_SG file m ku f y zs wws overSoXSynth2FDN_S + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf' with a possibility to adjust volume using 'adjust_dbVol'. 'V.Vector' of 'Double' is +-- used to specify adjustments in dB. For more information, please, refer to 'adjust_dbVol'. +overSoXSynth2FDN_Sf1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO () +overSoXSynth2FDN_Sf1G f (x, y) = overSoXSynth2FDN_Sf31G f (x, y, 0.001) + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf1G' with a possibility to specify sound quality using the second 'String' argument. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_Sf2G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_Sf2G f (x, y) = overSoXSynth2FDN_Sf32G f (x, y, 0.001) + +-- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf' function. 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@. +overSoXSynthGen2FDN_Sf :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO () +overSoXSynthGen2FDN_Sf file m ku f y zs wws = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + overSoXSynth2FDN_Sf f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB + endFromResult + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf3' function with a possibility to adjust volume using 'adjust_dBVol'. 'V.Vector' of 'Double' +-- specifies the needed adjustments in dB. +overSoXSynth2FDN_Sf31G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> IO () +overSoXSynth2FDN_Sf31G f (x, y, t0) j zs vdB = overSoXSynth2FDN_Sf32G f (x, y, t0) j zs vdB [] + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_Sf35G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_Sf35G f (x, y, t0) j v5 vdB ys + | V.null v5 = overSoXSynth x + | otherwise = do + let l0 = V.length v5 + soundGenF32G (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0) + (dNote (V.unsafeIndex v5 (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))]) + (V.replicate 2 x) (V.fromList [1,V.unsafeIndex v5 (abs (j `rem` l0))]) f (x, y, t0) j vdB ys + if null ys then mixTest else mixTest2G ys + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf35G' with afterwards 'apply6G' usage. +overSoXSynth2FDN_Sf36G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> V.Vector Double -> String -> Double -> IO () +overSoXSynth2FDN_Sf36G f (x, y, t0) j v5 vdB ys vol + | V.null v5 = overSoXSynth x + | otherwise = do + let l0 = V.length v5 + soundGenF32G (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0) + (dNote (V.unsafeIndex v5 (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))]) + (V.replicate 2 x) (V.fromList [1,V.unsafeIndex v5 (abs (j `rem` l0))]) f (x, y, t0) j vdB ys + if null ys then mixTest else mixTest2G ys + if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" + +-- | A variant of the 'overSoXSynth2FDN_Sf36G' where volume adjustment is obtained from a Ukrainian text. +overSoXSynth2FDN_Sf36GS :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> Intervals -> String -> V.Vector Double -> String -> String -> IO () +overSoXSynth2FDN_Sf36GS f (x, y, t0) j v5 xs vdB ys xxs + | V.null . convertToProperUkrainian $ xxs = putStrLn "You provided no information to obtain volume adjustment! " + | otherwise = overSoXSynth2FDN_Sf36G f (x, y, t0) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs) + +-- | Can generate multiple notes with their respective overtones that are played simultaneously (e. g. it can be just one note with overtones, +-- an interval with overtones, an accord with overtones etc.). This allows to get a rather complex or even complicated behaviour to obtain expressive +-- and rich sound. +soundGenF3 :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> IO () +soundGenF3 vf vd vi f (x, y, t0) j = soundGenF32G vf vd vi f (x, y, t0) j V.empty [] + +-- | Generalized variant of the 'soundGenF3' with volume adjustment in dB given by the second @Vector Double@ for the overtones. +soundGenF31G :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> + V.Vector Double -> IO () +soundGenF31G vf vd vi f (x, y, t0) j vdB = soundGenF32G vf vd vi f (x, y, t0) j vdB [] + +-- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf3' function. +overSoXSynthGen2FDN_Sf3 :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> IO () +overSoXSynthGen2FDN_Sf3 file m ku f y t0 zs wws = overSoXSynthGen2FDN_Sf3G file m ku f y t0 zs wws overSoXSynth2FDN_Sf3 + +-- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf3' function. 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@. +overSoXSynthGen2FDN_Sf3G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO ()) -> IO () +overSoXSynthGen2FDN_Sf3G file m ku f y t0 zs wws h = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB + endFromResult + +-- | Generalized variant of the 'ovorSoXSynthGen2FDN_Sf3G' with a possibility to specify sound quality with the third 'String' argument. +-- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. +-- For more information, please, refer to 'soxBasicParams'. 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@. +overSoXSynthGen2FDN_Sf3G2G :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () +overSoXSynthGen2FDN_Sf3G2G file m ku f y t0 zs wws h ys = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws ys + renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f" + then ".flac" else ".wav") vecB + endFromResult2G ys + diff --git a/DobutokO/Sound/Functional/Basics.hs b/DobutokO/Sound/Functional/Basics.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Functional/Basics.hs @@ -0,0 +1,383 @@ +-- | +-- Module : DobutokO.Sound.Functional.Basics +-- 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. Is more complicated than +-- dobutokO2 and uses its functionality. + +{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Functional.Basics ( + -- * Type synonyms with different semantics + SoundsO + , OvertonesO + , NotePairs + -- * Work with notes (general) + , notes + , neighbourNotes + , closestNote + , pureQuintNote + , overTones + -- * Work with overtones + , overSoXSynth + -- * Work with enky (extension to octaves functionality) + , nkyT + , whichOctave + , whichOctaveG + , whichEnka + , enkuUp + , enkuDown + , liftInEnkuV + , liftInEnku + -- ** Work with octaves + , octavesT + -- * Combining intermediate files + , mixTest + , mixTest2 + -- * Working with files + , freqsFromFile + , endFromResult + -- * Use additional function and Ukrainian texts and generates melody + , dNote + -- ** 2G generalized auxiliary functions + , mixTest2G + , mixTest22G + , endFromResult2G + -- ** Auxiliary functions + , partialTest_k + , partialTest_k1G + , partialTest_k2G + , prependZeroes + , nOfZeroesLog + , numVZeroesPre + , duration1000 + , adjust_dbVol +) where + +import CaseBi (getBFst') +import Data.Char (isDigit) +import System.Exit (ExitCode( ExitSuccess )) +import Numeric +import Data.List (isPrefixOf,sort) +import Data.Maybe (fromJust,isJust,fromMaybe) +import qualified Data.Vector as V +import SoXBasics (durationA) +import System.Process +import EndOfExe +import System.Directory +import DobutokO.Sound.IntermediateF + +-- | Is used to represent a sequence of intervals, each note being a 'Double' value (its frequency in Hz). +type SoundsO = V.Vector (Double, Double) + +-- | Is used to represent a set of overtones for the single sound, the first 'Double' value is a frequency and the second one -- an amplitude. +type OvertonesO = V.Vector (Double, Double) + +-- | Is used to represent a set of pairs of notes for each element of which the 'Double' values (notes frequencies in Hz) are somewhat +-- musically connected one with another.. +type NotePairs = V.Vector (Double, Double) + +-- | Gets 'V.Vector' of 'Int' frequencies from the given 'FilePath' using SoX. The frequencies are \"rough\" according to the SoX documentation and +-- the duration is too small so they can be definitely other than expected ones. Is used as a source of variable numbers (somewhat close each to another +-- in their order but not neccessarily). . +freqsFromFile :: FilePath -> Int -> IO (V.Vector Int) +freqsFromFile file n = V.generateM n (\k -> do { + (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat Nothing (fromIntegral k * 0.001) "", + "0.001", "stat"] "" + ; let line0s = lines herr + noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s + ; if null noteN0 then return (11440::Int) + else let noteN1 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) + +-- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work +-- on them properly. Afterwards, the function deletes these combined files. +mixTest :: IO () +mixTest = do + paths0 <- listDirectory "." + let paths = filter (isPrefixOf "test") $ paths0 + _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) "" + mapM_ removeFile paths + +-- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to +-- 'soxBasicParams'. +mixTest2G :: String -> IO () +mixTest2G ys = do + paths0 <- listDirectory "." + let paths = filter (isPrefixOf "test") $ paths0 + _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result.wav","vol","0.3"]) "" + mapM_ removeFile paths + +-- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work +-- on them properly. Afterwards, the function deletes these combined files. The name of the resulting file depends on the first two command line +-- arguments so that it is easy to produce unique names for the consequent call for the function. +mixTest2 :: Int -> Int -> IO () +mixTest2 zeroN j = do + paths0 <- listDirectory "." + let paths = filter (isPrefixOf "test") $ paths0 + _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav", + "vol","0.3"]) "" + mapM_ removeFile paths + +-- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to +-- 'soxBasicParams'. The name of the resulting file depends on the first two command line +-- arguments so that it is easy to produce unique names for the consequent call for the function. +mixTest22G :: Int -> Int -> String -> IO () +mixTest22G zeroN j ys = do + paths0 <- listDirectory "." + let paths = filter (isPrefixOf "test") $ paths0 + _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result" ++ prependZeroes zeroN (show j) ++ + ".wav","vol","0.3"]) "" + mapM_ removeFile paths + +-- | Gets an \"end.wav\" file from the intermediate \"result\*.wav\" files in the current directory. If it is not successful, produces the notification +-- message and exits without error. If you would like to create the file if there are too many intermediate ones, please, run +-- \"dobutokO2 8\" or \"dobutokO2 80\" in the current directory. +endFromResult :: IO () +endFromResult = do + path2s <- listDirectory "." + let paths3 = sort . filter (isPrefixOf "result") $ path2s + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) "" + case code of + ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " + _ -> do + exi <- doesFileExist "end.wav" + if exi then removeFile "end.wav" + else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >> + putStrLn "Use them manually as needed." + +-- | Similar to 'endFromResult', but uses additional 'String' argument to change sound quality parameters. For more information, please, refer to +-- 'soxBasicParams'. +endFromResult2G :: String -> IO () +endFromResult2G ys = do + path2s <- listDirectory "." + let paths3 = sort . filter (isPrefixOf "result") $ path2s + (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ soxBasicParams ys ["","end.wav"]) "" + case code of + ExitSuccess -> putStrLn $ "The final file \"end." ++ if drop 3 ys == "f" then "flac" else "wav" ++ "\" was successfully created. You can now manually change or delete \"result*\" files in the directory. " + _ -> do + exi <- doesFileExist $ "end." ++ if drop 3 ys == "f" then "flac" else "wav" + if exi then removeFile $ "end." ++ if drop 3 ys == "f" then "flac" else "wav" + else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >> + putStrLn "Use them manually as needed." + +-- | Creates part of the needed \"test\*\.wav" files in the current directory. +partialTest_k :: OvertonesO -> Int -> String -> IO () +partialTest_k vec k ts = partialTest_k2G vec k ts V.empty [] + +-- | Generalized version of the 'partialTest_k' with the additional volume adjustment in dB given by 'V.Vector' of 'Double'. +partialTest_k1G :: OvertonesO -> Int -> String -> V.Vector Double -> IO () +partialTest_k1G vec k ts vdB = partialTest_k2G vec k ts vdB [] + +-- | Generalized version of the 'partialTest_k1G' with a possibility to change sound quality parameters using the additional second 'String' argument. +-- For more information, please, refer to 'soxBasicParams'. +partialTest_k2G :: OvertonesO -> Int -> String -> V.Vector Double -> String -> IO () +partialTest_k2G vec k ts vdB ys = + let zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 50 == 0 + then do + _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", + "synth", ts,"sine", showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""] + (V.unsafeIndex vdB i))) "" + path1s <- listDirectory "." + let path2s = sort . filter (isPrefixOf $ "test" ++ show k) $ path1s + (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ soxBasicParams ys ["","test-" ++ show k ++ + prependZeroes zeroN (show (i `quot` 50)) ++ ".wav"]) "" + case code of + ExitSuccess -> mapM_ removeFile path2s + _ -> do + exi <- doesFileExist $ "test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav" + if exi then putStrLn (herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav") + else putStrLn herr0 + else readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ((if V.null vdB then id + else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", + "synth", ts,"sine", showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""])) "" >> putStr "") vec + +-- | Auxiliary function to get from a sound file specified a duration parameter @n@ that can be used further. +duration1000 :: FilePath -> IO Int +duration1000 file = fmap (\t -> truncate (t / 0.001)) . durationA $ file + +-- | Function to get from the number of semi-tones and a note a 'Maybe' note for the second lower note in the interval if any. If there is +-- no need to obtain such a note, then the result is 'Nothing'. +dNote :: Int -> Double -> Maybe Double +dNote n note + | n == 0 || compare note (V.unsafeIndex notes 0) == LT || compare note (V.unsafeIndex notes 107) == GT = Nothing + | otherwise = Just (note / 2 ** (fromIntegral n / 12)) + +-- | 'V.Vector' of musical notes in Hz. +notes :: V.Vector Double +-- notes V.! 57 = 440.0 -- A4 in Hz +notes = V.generate 108 (\t -> 440 * 2 ** (fromIntegral (t - 57) / 12)) + +-- | Function returns either the nearest two musical notes if frequency is higher than one for C0 and lower than one for B8 +-- or the nearest note duplicated in a tuple. +neighbourNotes :: Double -> V.Vector Double -> (Double, Double) +neighbourNotes x v + | compare x (V.unsafeIndex v 0) /= GT = (V.unsafeIndex v 0, V.unsafeIndex v 0) + | compare x (V.unsafeIndex v (V.length v - 1)) /= LT = (V.unsafeIndex v (V.length v - 1), V.unsafeIndex v (V.length v - 1)) + | compare (V.length v) 2 == GT = if compare x (V.unsafeIndex v (V.length v `quot` 2)) /= GT + then neighbourNotes x (V.unsafeSlice 0 (V.length v `quot` 2 + 1) v) + else neighbourNotes x (V.unsafeSlice (V.length v `quot` 2) (V.length v - (V.length v `quot` 2)) v) + | otherwise = (V.unsafeIndex v 0, V.unsafeIndex v (V.length v - 1)) + +-- | Returns the closest note to the given frequency in Hz. +closestNote :: Double -> Double +closestNote x + | compare x 0.0 == GT = + let (x0, x2) = neighbourNotes x notes + r0 = x / x0 + r2 = x2 / x in + if compare r2 r0 == GT + then x0 + else x2 + | otherwise = 0.0 + +-- | Additional function to prepend zeroes to the given 'String'. The number of them are just that one to fulfill the length to the given 'Int' parameter. +prependZeroes :: Int -> String -> String +prependZeroes n xs + | if compare n 0 /= GT || null xs then True else compare n (length xs) /= GT = xs + | otherwise = replicate (n - length xs) '0' ++ xs +{-# INLINE prependZeroes #-} + +nOfZeroesLog :: Int -> Maybe Int +nOfZeroesLog x + | compare x 0 /= GT = Nothing + | otherwise = Just (truncate (logBase 10 (fromIntegral x)) + 1) +{-# INLINE nOfZeroesLog #-} + +-- | Is a minimal number of decimal places that are just enough to represent a length of the 'V.Vector' given. For an 'V.empty' returns 0. +numVZeroesPre :: V.Vector a -> Int +numVZeroesPre v = fromMaybe (0 :: Int) (nOfZeroesLog . V.length $ v) +{-# INLINE numVZeroesPre #-} + +-- | Similarly to 'liftInOctaveV' returns a 'V.Vector' 'Double' (actually frequencies) for the n-th elements set of notes (see 'nkyT') instead of octaves. +-- A second 'Int' parameter defines that @n@. +liftInEnkuV :: Int -> Int -> V.Vector Double -> V.Vector Double +liftInEnkuV n ku = V.mapMaybe (liftInEnku n ku) + +-- | Similarly to 'liftInOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). +-- A second 'Int' parameter defines that @n@. Not all pairs return 'Just' @x@. +liftInEnku :: Int -> Int -> Double -> Maybe Double +liftInEnku n ku x + | compare n 0 == LT || compare n ((108 `quot` ku) - 1) == GT = Nothing + | getBFst' (False, V.fromList . zip [2,3,4,6,9,12] $ repeat True) ku && compare (closestNote x) 24.4996 == GT = + case compare (fromJust . whichEnka ku $ x) n of + EQ -> Just (closestNote x) + LT -> let z = logBase 2.0 (V.unsafeIndex notes (n * ku) / 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) (enkuUp ku) $ closestNote x) + else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 2) (enkuUp ku) $ closestNote x) + _ -> let z = logBase 2.0 (closestNote x / V.unsafeIndex notes (n * ku)) + 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) (enkuDown ku) $ closestNote x) + else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 1) (enkuDown ku) $ closestNote x) + | otherwise = Nothing + +-- | Similarly to 'whichOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). +-- An 'Int' parameter defines that @n@. +whichEnka :: Int -> Double -> Maybe Int +whichEnka n x + | getBFst' (False,V.fromList . zip [2,3,4,6,9,12] $ repeat True) n && compare (closestNote x) 24.4996 == GT = (\t -> + case isJust t of + True -> fmap (\z -> + case z of + 0 -> z + _ -> z - 1) t + _ -> Just ((108 `quot` n) - 1)) . V.findIndex (\(t1, _) -> compare (closestNote x) t1 == LT) . nkyT $ n + | otherwise = Nothing + +-- | Returns an analogous note in the higher n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@. +enkuUp :: Int -> Double -> Double +enkuUp n x + | getBFst' (False, V.fromList . zip [2..11] $ repeat True) n = 2 ** (fromIntegral n / 12) * x + | otherwise = 2 * x +{-# INLINE enkuUp #-} + +-- | Returns an analogous note in the lower n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@. +enkuDown :: Int -> Double -> Double +enkuDown n x + | getBFst' (False, V.fromList . zip [2..11] $ repeat True) n = 2 ** (fromIntegral (-n) / 12) * x + | otherwise = x / 2 +{-# INLINE enkuDown #-} + +-- | Returns a 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the sets consisting of @n@ consequential notes +-- (including semi-tones). An 'Int' parameter defines this @n@. It can be 2, 3, 4, 6, 9, or 12 (the last one is for default octaves, see 'octavesT'). +-- So for different valid @n@ you obtain doubles, triples and so on. The function being applied returns a 'V.Vector' of such sets with +-- their respective lowest and highest frequencies. +nkyT :: Int -> NotePairs +nkyT n + | getBFst' (False,V.fromList . zip [2,3,4,6,9,12] $ repeat True) n = V.generate (108 `quot` n) (\i -> (V.unsafeIndex notes (i * n), + V.unsafeIndex notes (i * n + (n - 1)))) + | otherwise = octavesT + +-- | Returns a 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the octaves. +octavesT :: NotePairs +octavesT = V.generate 9 (\i -> (V.unsafeIndex notes (i * 12), V.unsafeIndex notes (i * 12 + 11))) + +-- | 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*\" and \"end.wav\" files in the current directory, because they can be overwritten. +overSoXSynth :: Double -> IO () +overSoXSynth x = do + let note0 = if x /= 0.0 then closestNote (abs x) else V.unsafeIndex notes 0 + note1 = pureQuintNote note0 + v0 = overTones note0 + v1 = overTones note1 + overSoXSynthHelp = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") + overSoXSynthHelp2 = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox")) + ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") + _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", showFFloat Nothing note0 "", "synth", "0.5","sine", "mix", showFFloat Nothing note1 "", "vol","0.5"] "" + overSoXSynthHelp v0 + overSoXSynthHelp2 v1 + mixTest + +-- | Returns a pure quint lower than the given note. +pureQuintNote :: Double -> Double +pureQuintNote x = x / 2 ** (7 / 12) +{-# INLINE pureQuintNote #-} + +-- | 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. +overTones :: Double -> OvertonesO +overTones note = + V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.zip (V.generate 1024 (\i -> + note * fromIntegral (i + 2))) $ (V.generate 1024 (\i -> 1 / fromIntegral ((i + 1) * (i + 1)))) + +-- | Function can be used to determine to which octave (in the American notation for the notes, this is a number in the note written form, +-- e. g. for C4 this is 4) the frequency belongs (to be more exact, the closest note for the given frequency -- see 'closestNote' taking into account +-- its lower pure quint, which can lay in the lower by 1 octave). If it is not practical to determine the number, then the function returns 'Nothing'. +whichOctave :: Double -> Maybe Int +whichOctave x + | compare (closestNote x) 24.4996 == GT = (\t -> + case isJust t of + True -> fmap (\z -> + case z of + 0 -> z + _ -> z - 1) t + _ -> Just 8) . V.findIndex (\(t1, _) -> compare (closestNote x) t1 == LT) $ octavesT + | otherwise = Nothing + +-- | Generalized version of the 'whichOctave'. +whichOctaveG :: Double -> Maybe Int +whichOctaveG x + | compare (closestNote x) (V.unsafeIndex notes 0) == GT && compare x (V.unsafeIndex notes 107) /= GT = (\t -> + case isJust t of + True -> fmap (\z -> + case z of + 0 -> z + _ -> z - 1) t + _ -> Just 8) . V.findIndex (\(t1, _) -> compare (closestNote x) t1 == LT) $ octavesT + | otherwise = Nothing + +-- | Is used internally in the 'readProcessWithExitCode' to adjust volume for the sound with additional dB value given by 'Double' argument. +adjust_dbVol :: [String] -> Double -> [String] +adjust_dbVol xss y + | y == 0.0 = xss + | otherwise = xss ++ ["vol",showFFloat Nothing y "dB"] + + diff --git a/DobutokO/Sound/Functional/Elements.hs b/DobutokO/Sound/Functional/Elements.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Functional/Elements.hs @@ -0,0 +1,248 @@ +-- | +-- Module : DobutokO.Sound.Functional.Elements +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Functional.Elements ( + -- * Functions to edit OvertonesO and function f + renormF + , renormFD + , sameOvertone + , sameOvertoneL + , sameFreqF + , sameFreqFI + , fAddFElem + , fRemoveFElem + , fChangeFElem + , gAdd01 + , gAdd02 + , gAdd03 + , gAdd04 + , gRem01 + , gRem02 + , gRem03 + -- ** Working with two OvertonesO + , fAddFElems + , fRemoveFElems + , fChangeFElems + , freqsOverlapOvers + , elemsOverlapOvers + , gAdds01 + , gAdds02 +) where + +import Data.List (sort,sortBy) +import qualified Data.Vector as V +import DobutokO.Sound.Functional.Basics + +-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not 'V.empty') is equal by the absolute value +-- to 1.0 and the mutual ratios of the amplitudes are preserved. +renormF :: OvertonesO -> OvertonesO +renormF v + | V.null v = V.empty + | otherwise = + let v1 = V.fromList . sortBy (\(_,y1) (_,y2)-> compare (abs y2) (abs y1)) . V.toList $ v in + if (\(_,y) -> y == 0.0) . V.unsafeIndex v1 $ 0 then V.empty + else V.map (\(x,y) -> (x, y / (snd . V.unsafeIndex v1 $ 0))) v1 + +-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not 'V.empty') is equal by the absolute value +-- to 'Double' argument and the mutual ratios of the amplitudes are preserved. +renormFD :: Double -> OvertonesO -> OvertonesO +renormFD ampl0 v + | V.null v = V.empty + | otherwise = + let v1 = V.fromList . sortBy (\(_,y1) (_,y2)-> compare (abs y2) (abs y1)) . V.toList $ v in + if (\(_,y) -> y == 0.0) . V.unsafeIndex v1 $ 0 then V.empty + else V.map (\(x,y) -> (x, ampl0 * y / (snd . V.unsafeIndex v1 $ 0))) v1 + +-- | Predicate to check whether all tuples in a 'V.Vector' have the same first element. +sameOvertone :: OvertonesO -> Bool +sameOvertone v + | V.null v = False + | otherwise = V.all (\(x,_) -> x == (fst . V.unsafeIndex v $ 0)) v + +-- | Similar to 'sameOvertone', except that not the 'V.Vector' is checked but a corresponding list. +sameOvertoneL :: [(Double,Double)] -> Bool +sameOvertoneL xs@((x,_):_) = all (\(xn,_) -> xn == x) xs +sameOvertoneL _ = False + +-- | @g :: (Double,Double) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'. It depends +-- only on the element being added and the actual 'OvertonesO'. It does not depend on the 'Double' argument for @f :: Double -> OvertonesO@ +-- so for different 'Double' for @f@ it gives the same result. +sameFreqF :: Double -> (Double,Double) -> (Double -> OvertonesO) -> ((Double,Double) -> OvertonesO -> OvertonesO) -> OvertonesO +sameFreqF freq (noteN0,amplN0) f g = g (noteN0,amplN0) (f freq) + +-- | @g :: (Double,Double) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'. +-- Variant of 'sameFreqF' where g depends only on the elements of the 'OvertonesO', which first elements in the tuples equal to the first element +-- in the @(Double,Double)@. It does not depend on the 'Double' argument for @f :: Double -> OvertonesO@ +-- so for different 'Double' for @f@ it gives the same result. +sameFreqFI :: Double -> (Double,Double) -> (Double -> OvertonesO) -> ((Double,Double) -> OvertonesO -> OvertonesO) -> OvertonesO +sameFreqFI freq (noteN0,amplN0) f g = g (noteN0,amplN0) . V.filter (\(x,_) -> x == noteN0) $ f freq + +-- | @gAdd :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO@ is a function that defines how the element is added +-- to the 'OvertonesO'. 'fAddFElem' is +-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task +-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example similar to that ones that +-- are used for quantum mechanics and quantum field theory). +-- @gAdd@ allows not only to insert an element if missing, but to change all the 'OvertonesO' system. So depending on the complexity, +-- it can produce rather complex behaviour. +fAddFElem :: (Double, Double) -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> + (Double -> OvertonesO) +fAddFElem (noteN, amplN) f gAdd t = gAdd (noteN, amplN) t f + +-- | @gRem:: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO@ is a function that defines how the element is removed +-- from the 'OvertonesO'. 'fRemoveFElem' is +-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task +-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example that ones that are used +-- for quantum mechanics and quantum field theory). +-- @gRem@ allows not only to delete an element if existing, but to change all the 'OvertonesO' system. So depending on the complexity, +-- it can produce rather complex behaviour. +fRemoveFElem :: (Double, Double) -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> + (Double -> OvertonesO) +fRemoveFElem (noteN, amplN) f gRem t = gRem (noteN, amplN) t f + +-- | Changes elements of the 'OvertonesO' using two functions. It is a generalization of the 'fAddFElem' and 'fRemoveFElem' functions. For example, if the first +-- of the two inner functional arguments acts as 'gAdd01' or similar, then it adds element to the 'OvertonesO', if it acts as 'gRem01', then it removes the element. +-- Its behaviour is defined by the 'Double' parameter (meaning frequency, probably), so you can change elements depending on what point it is applied. +fChangeFElem :: (Double, Double) -> Double -> (Double -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO)) -> (Double -> OvertonesO) -> + (Double -> OvertonesO) +fChangeFElem (noteN, amplN) freq h f t = (h freq) (noteN, amplN) t f + +-- | Example of the function gAdd for the 'fAddFElem'. If the frequency is already in the 'OvertonesO' then the corresponding amplitude is divided +-- equally between all the elements with the repeated given frequency from @(Double, Double)@. Otherwise, it is just concatenated to the 'OvertonesO'. +gAdd01 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO +gAdd01 (note,ampl) freq f + | V.null . f $ freq = V.singleton (note,ampl) + | otherwise = + let v1 = renormF . f $ freq in + let v2 = V.findIndices (\(x,_) -> x == note) v1 in + if V.null v2 then V.cons (note,ampl) (f freq) + else renormF . V.imap (\i (t,w) -> if i `V.elem` v2 then (t,w + ampl / fromIntegral (V.length v2)) else (t,w)) $ v1 + +-- | Can be used to produce an example of the function @gAdd@ for the 'fAddFElem'. Similar to 'gAdd01', but uses its first argument +-- to renorm the result of the 'gAdd01' so that its maximum by absolute value amplitude equals to the first argument. +gAdd02 :: Double -> (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO +gAdd02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq + +-- | Example of the function @gAdd@. for the 'fAddFElem'. If the frequency is not already in the 'OvertonesO' then the corresponding element is added and +-- the 'OvertonesO' are renormed with 'renormF'. Otherwise, the element is tried to be inserted with a new frequency between the greatest by an absolute +-- values notes as an intermediate value with the respective amplitude, or if there is only one element, to produce two elements in +-- the resulting 'V.Vector' with two consequent harmonics. +gAdd03 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO +gAdd03 (note,ampl) freq f + | V.null . f $ freq = V.singleton (note,ampl) + | otherwise = + let v1 = renormF . f $ freq in + let v2 = V.findIndices (\(x,_) -> x == note) v1 in + if V.null v2 then renormF . V.cons (note,ampl) $ f freq + else + let xs = sortBy (\(x1,_) (x2,_)-> compare (abs x2) (abs x1)) . V.toList $ v1 + l = V.length v1 + ys = if compare l 1 == GT then ((fst . head $ xs) + (fst . head . tail $ xs) / 2,ampl):xs + else [(note,((snd . V.unsafeIndex v1 $ 0) + ampl) / 2),(2 * note,(abs ((snd . V.unsafeIndex v1 $ 0) - ampl)) / 2)] in + renormF . V.fromList $ ys + +-- | Example of the function gRem for the 'fRemoveFElem'. If the element is already in the 'OvertonesO' then it is removed (if there are more than 5 +-- elements already) and 'OvertonesO' are renormalized. Otherwise, all the same for the element already existing elements become less in an amlitude +-- for a numbers that in sum equal to amplitude of the removed element. +gRem01 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO +gRem01 (note,ampl) freq f + | V.null . f $ freq = V.empty + | otherwise = + let v1 = renormF . f $ freq in + let v2 = V.findIndices (\(x,y) -> x == note && y == ampl) v1 in + if V.null v2 then + if compare (V.length v1) 5 == GT then renormF . V.unsafeSlice 0 (V.length v1 - 1) $ v1 + else v1 + else renormF . V.imap (\i (t,w) -> if i `V.elem` v2 then (t,w - ampl / fromIntegral (V.length v2)) else (t,w)) $ v1 + +-- | Can be used to produce an example of the function @gRem@ for the 'fRemoveFElem'. Similar to 'gRem01', but uses its first argument +-- to renorm the result of the 'gRem01' so that its maximum by absolute value amplitude equals to the first argument. +gRem02 :: Double -> (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO +gRem02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq + +-- | Similar to 'fAddFElem', but instead of one element @(Double,Double)@ it deals with a 'V.Vector' of such elements that is 'OvertonesO'. +fAddFElems :: OvertonesO -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> + (Double -> OvertonesO) +fAddFElems v f gAdds t = gAdds v t f + +-- | Similar to 'fRemoveFElem', but instead of one element @(Double,Double)@ it deals with a 'V.Vector' of such elements that is 'OvertonesO'. +fRemoveFElems :: OvertonesO -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> + (Double -> OvertonesO) +fRemoveFElems v f gRems t = gRems v t f + +-- | Similar to 'fChangeFElem', but use another form of the changing function, so it can deal with not only single element of the 'OvertonesO', +-- but also with several ones. +fChangeFElems :: OvertonesO -> Double -> (Double -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO)) -> (Double -> OvertonesO) -> + (Double -> OvertonesO) +fChangeFElems v freq h f t = (h freq) v t f + +-- | Binary predicate to check whether two given 'OvertonesO' both have the elements with the same first element in the tuples. If 'True' then +-- this means that 'OvertonesO' are at least partially overlaped by the first elements in the tuples (meaning frequencies). +freqsOverlapOvers :: OvertonesO -> OvertonesO -> Bool +freqsOverlapOvers v1 v2 = + let [v11,v21] = map (V.map fst) [v1,v2] + v22 = V.filter (<= V.maximum v11) v21 in + if V.null v22 then False + else + let v12 = V.filter (>= V.minimum v21) v11 + [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22] + [l1,l2] = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT + +-- | Similar to 'freqsOverlapOvers', but checks whether the whole tuples are the same instead of the first elements in the tuples are the same. +elemsOverlapOvers :: OvertonesO -> OvertonesO -> Bool +elemsOverlapOvers v1 v2 = + let v22 = V.filter (\(x,_) -> x <= fst (V.maximumBy (\(x1,_) (t,_) -> compare x1 t) v1)) v2 in + if V.null v22 then False + else + let v12 = V.filter (\(x,_) -> x >= fst (V.minimumBy (\(x1,_) (t,_) -> compare x1 t) v2)) v1 + [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22] + [l1,l2] = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT + +-- | Example of the function @gAdds@ for the 'fAddFElems'. +gAdds01 :: OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO +gAdds01 v0 freq f + | V.null . f $ freq = v0 + | freqsOverlapOvers v0 (f freq) = + let ys = sortBy (\(x1,_) (x2,_) -> compare x1 x2) . V.toList $ v0 + h ys + | null ys = [] + | otherwise = (takeWhile (not . (/= head ys)) ys):h (dropWhile (not . (/= head ys)) ys) + h1 = map (\zs -> (sum . map snd $ zs) / fromIntegral (length zs)) . h + h2 ys = map (fst . head) (h ys) + v2 = V.fromList . zip (h2 ys) $ (h1 ys) + us = sortBy (\(x1,_) (x2,_) -> compare x1 x2) . V.toList $ f freq + v3 = V.fromList . zip (h2 us) $ (h1 us) in renormF . V.concat $ [v2,v3] + | otherwise = renormF . V.concat $ [v0, f freq] + +-- | Can be used to produce an example of the function @gAdds@ for the 'fAddFElems'. Similar to 'gAdds01', but uses its first argument +-- to renorm the result of the 'gAdds01' so that its maximum by absolute value amplitude equals to the first argument. +gAdds02 :: Double -> OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO +gAdds02 amplMax v0 freq = renormFD amplMax . gAdds01 v0 freq + +-- | Example of the function @gAdd@. for the 'fAddFElem'. It tries to insert the given ('Double','Double') into the less dense frequency region. +gAdd04 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO +gAdd04 (note,ampl) freq f + | V.null . f $ freq = V.singleton (note,ampl) + | otherwise = + let v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare x1 x2) . V.toList . f $ freq + v2 = V.zipWith (\(x1,_) (x2,_) -> x2 - x1) v1 (V.unsafeSlice 1 (V.length v1 - 1) v1) + idxMax = V.maxIndex v2 + newFreq = (fst (V.unsafeIndex v1 (idxMax + 1)) + fst (V.unsafeIndex v1 idxMax)) / 2 in (newFreq,ampl) `V.cons` v1 + +-- | Example of the function @gRem@ for the 'fRemFElem'. It tries not to remove elements from the less than 6 elements 'OvertonesO' and to remove +-- all the elements in the given range with the width of the twice as many as the second 'Double' in the first argument tuple and the centre +-- in the first 'Double' in the tuple. Similar to somewhat bandreject filter but with more complex behaviour for the sound to be more complex. +gRem03 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO +gRem03 (note,halfwidth) freq f = + let v1 = V.filter (\(x,_) -> compare (abs (x - note)) halfwidth /= GT) . f $ freq in + if compare (V.length v1) 5 /= GT then renormF . V.generate 5 $ (\i -> (fromIntegral (i + 1) * note, halfwidth / fromIntegral (i + 3))) + else v1 + diff --git a/DobutokO/Sound/Functional/Params.hs b/DobutokO/Sound/Functional/Params.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Functional/Params.hs @@ -0,0 +1,534 @@ +-- | +-- Module : DobutokO.Sound.Functional.Params +-- 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. Is more complicated than +-- dobutokO2 and uses its functionality. + +{-# LANGUAGE BangPatterns, LambdaCase #-} +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Functional.Params ( + Params (..) + -- * Type synonyms with different semantics + , Durations + , Strengths + , Intervals + -- * New generalizations for scales and modes with Params + , filterInParams + , sortNoDup + , toneD + , toneE + , liftInParams + , liftInParamsV + , lengthP + , elemP + , elemCloseP + , showD + , isStrParams + , isListParams + -- ** Application of the Params + , overSoXSynthGen2FDN_SG4GPar + , overSoXSynthGen2FDN_SG6GPar + , overSoXSynthGen2FDN_SG2GPar + , overSoXSynthGen2FDN_SfPar + , overSoXSynthGen2FDN_Sf3GPar + , overSoXSynthGen2FDN_Sf3G2GPar + -- * Creating melody from overtones + , overMeloPar + -- * Additional functions + , str2DurationsDef + , signsFromString + , apply6Gf + , apply6GSilentFile + , vStrToVIntG + , strToIntG + , defInt + , syllableStr + , overSoXSynth2FDN_Sf + , overSoXSynth2FDN_Sf3 + , overSoXSynth2FDN_Sf32G + , intervalsFromString + , soundGenF32G + , helpF0 + , helpF1 + , doubleVecFromVecOfDouble +) where + +import CaseBi (getBFst') +import Numeric +import Data.List (sort) +import Data.Maybe (isNothing,fromJust,isJust,fromMaybe) +import qualified Data.Vector as V +import System.Process +import EndOfExe +import System.Directory +import Melodics.Ukrainian (convertToProperUkrainian) +import SoXBasics (upperBnd,selMaxAbs) +import MMSyn7l +import MMSyn7.Syllable +import DobutokO.Sound.IntermediateF +import DobutokO.Sound.Functional.Basics + +-- | Representation of the scales and modes for the notes. Can be extended further, but for a lot of situations the following realization is sufficient. +-- See, for example, 'filterInParams' and so on. 'String' is (are) used as a general classification name, for some of them there are provided two +-- 'String' to classify. Lists are used to specify remainders in some meaning. See also, 'liftInParams' and 'toneE' ('toneD') functions, 'elemP' and +-- 'elemCloseP', 'lengthP' and 'showD'. +data Params = P2 Int Int | P2s Int Int String | P3sf Int Int Int String | P4lsf Int Int Int [Int] String | P32sf Int Int Int String String + | P3lf Int Int [Int] deriving (Eq, Ord, Show) + +-- | Is used to represent a set of durations parameters of the sounds and pauses. The positive value corresponds to the sound +-- and the negative one -- to the pause. +type Durations = V.Vector Double + +-- | Is used to represent a set of volumes in the amplitude scale for SoX \"vol\" effect. +type Strengths = V.Vector Double + +-- | Is used to represent a set of intervals for notes (each element is a number of semi-tones between parts of interval). +-- Positive values corresponds to lower notes and negative to higher ones. +type Intervals = V.Vector Int + +-- | 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 + +-- | Generalized version of the 'overSoXSynthGen2FDN_SG4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'. +overSoXSynthGen2FDN_SG4GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Durations -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO () +overSoXSynthGen2FDN_SG4GPar file params f y v2 wws h = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInParamsV params . V.map fromIntegral $ vecA + zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB + endFromResult + +-- | Generalized version of the 'overSoXSynthGen2FDN_SG6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'. +overSoXSynthGen2FDN_SG6GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Durations -> String -> + ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Strengths -> Double -> IO () +overSoXSynthGen2FDN_SG6GPar file params f y v2 wws h v6 limV + | V.null v6 = putStrLn "You did not provide a volume adjustments vector! " + | otherwise = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInParamsV params . V.map fromIntegral $ vecA + zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav" + apply6GSilentFile ("result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") limV (V.unsafeIndex v6 (j `rem` V.length v6))) vecB + endFromResult + +-- | Generalized version of the 'overSoXSynthGen2FDN_SG2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'. +overSoXSynthGen2FDN_SG2GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) -> + (Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () +overSoXSynthGen2FDN_SG2GPar file params f y zs wws h ys = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInParamsV params . V.map fromIntegral $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws ys + renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ + if drop 3 ys == "f" then ".flac" else ".wav") vecB + endFromResult2G ys + +-- | Generalized version of the 'overSoXSynthGen2FDN_Sf' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'. +overSoXSynthGen2FDN_SfPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> String -> String -> IO () +overSoXSynthGen2FDN_SfPar file params f y zs wws = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInParamsV params . V.map fromIntegral $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + overSoXSynth2FDN_Sf f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB + endFromResult + +-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'. +overSoXSynthGen2FDN_Sf3GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO ()) -> IO () +overSoXSynthGen2FDN_Sf3GPar file params f y t0 zs wws h = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInParamsV params . V.map fromIntegral $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws + renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB + endFromResult + +-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'. +overSoXSynthGen2FDN_Sf3G2GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Double -> String -> String -> + ((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO () +overSoXSynthGen2FDN_Sf3G2GPar file params f y t0 zs wws h ys = do + n <- duration1000 file + vecA <- freqsFromFile file n + let vecB = liftInParamsV params . V.map fromIntegral $ vecA + zeroN = numVZeroesPre vecB + v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do + h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws ys + renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f" + then ".flac" else ".wav") vecB + endFromResult2G ys + +-- | A way to get from a 'Params' a corresponding 'V.Vector' of 'Double' (if any) and so to work with them further. May contain some issues +-- so please, before production usage check thoroughly. +-- For information there were used the following: +-- +-- https://en.wikipedia.org/wiki/Mode_(music) +-- +-- https://en.wikipedia.org/wiki/Ukrainian_Dorian_scale +-- +-- https://en.wikipedia.org/wiki/List_of_musical_scales_and_modes +-- +-- https://en.wikipedia.org/wiki/Octatonic_scale +-- +-- several other articles in the English Wikipedia +-- +-- and in Ukrainian: +-- Смаглій Г., Маловик Л. Теорія музики : Підруч. для навч. закл. освіти, культури і мистецтв / Г.А. Смаглій. -- Х. : Вид-во \"Ранок\", 2013. -- 392 с. +-- ISBN 978-617-09-1294-7 +-- +filterInParams :: Params -> Maybe (V.Vector Double) +filterInParams (P3lf n2 nL zs) -- generalized sound series, e. g. the chromatic ones etc. + | all (\n -> compare n 0 /= LT) ([nL,107 - nL - n2,n2 - 2] ++ zs) = + if V.null . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) i) $ + (V.unsafeSlice nL n2 notes) + then Nothing + else Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) i) + (V.unsafeSlice nL n2 notes)) + | otherwise = Nothing +filterInParams (P32sf nT n2 nL xs ys) -- dur and moll in various their modifications + | all (\n -> compare n 0 /= LT) [107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 12] = + case xs of + "dur" -> getBFst' (Nothing,V.fromList . zip ["DoubleH","H","Full","Full moll","M","N"] $ fmap Just + [V.ifilter (\i _ -> toneD i nL nT [2,3,6,8,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,3,5,9,10]) + (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,3,5]) + (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6]) + (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,3,5,9,11]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneD i nL nT [1,3,5,8,10]) (V.unsafeSlice nL n2 notes)]) ys + "moll" -> getBFst' (Nothing,V.fromList . zip ["DoubleH1","H","Full","Full dur","M","N"] $ fmap Just + [V.ifilter (\i _ -> toneD i nL nT [1,4,5,9,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,4,6,9,10]) + (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,4,6]) + (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6]) + (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,4,6,8,10]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneD i nL nT [1,4,6,9,11]) (V.unsafeSlice nL n2 notes)]) ys + _ -> Nothing + | otherwise = Nothing +filterInParams (P4lsf nT n2 nL zs xs) + | all (\n -> compare n 0 /= LT) ([107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 2] ++ zs) = + case xs of + "ditonic" -> + if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) $ (V.unsafeSlice nL n2 notes)) /= 2 + then Nothing + else + if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 2 . sortNoDup . filter (< n2) $ zs) $ + replicate n2 True) i) (V.unsafeSlice nL n2 notes)) + then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 2 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) (V.unsafeSlice nL n2 notes)) + else Nothing + "tritonic" -> + if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) $ (V.unsafeSlice nL n2 notes)) /= 3 + then Nothing + else + if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 3 . sortNoDup . filter (< n2) $ zs) $ + replicate n2 True) i) (V.unsafeSlice nL n2 notes)) + then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 3 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) (V.unsafeSlice nL n2 notes)) + else Nothing + "tetratonic" -> + if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) $ (V.unsafeSlice nL n2 notes)) /= 4 + then Nothing + else + if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 4 . sortNoDup . filter (< n2) $ zs) $ + replicate n2 True) i) (V.unsafeSlice nL n2 notes)) + then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 4 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) (V.unsafeSlice nL n2 notes)) + else Nothing + "octatonic" -> + if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) $ (V.unsafeSlice nL n2 notes)) /= 8 + then Nothing + else + if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 8 . sortNoDup . filter (< n2) $ zs) $ + replicate n2 True) i) (V.unsafeSlice nL n2 notes)) + then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 8 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) (V.unsafeSlice nL n2 notes)) + else Nothing + _ -> Nothing + | compare nL 0 /= LT && compare nL 107 /= GT && n2 == 1 && xs == "monotonic" = Just (V.singleton (V.unsafeIndex notes nL)) + | otherwise = Nothing +filterInParams (P2 nL n2) + | all (\n -> compare n 0 /= LT) [107 - nL - n2,nL,n2 - 2] = Just (V.unsafeSlice nL n2 notes) + | otherwise = Nothing +filterInParams (P2s nL n2 xs) + | all (\n -> compare n 0 /= LT) [107 - nL - n2,nL,n2 - 12] = + getBFst' (Nothing,V.fromList . zip ["Egyptian pentatonic", "Prometheus hexatonic scale", "Ukrainian Dorian scale", "augmented hexatonic scale", + "blues major pentatonic", "blues minor pentatonic", "blues scale", "major hexatonic scale", "major pentatonic", "minor hexatonic scale", + "minor pentatonic", "tritone hexatonic scale", "two-semitone tritone hexatonic scale", "whole tone scale"] $ map Just + [V.ifilter (\i _ -> toneE i nL nL [0,2,5,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,2,4,6,9,10]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneE i nL nL [0,2,3,6,7,9,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,4,7,8,11]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneE i nL nL [0,2,5,7,9]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,8,10]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneE i nL nL [0,3,5,6,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,6,7,10]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneE i nL nL [0,2,4,5,7,9]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,2,4,7,9]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneE i nL nL [0,2,3,5,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,7,10]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneE i nL nL [0,1,4,6,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,1,3,7,8,9]) (V.unsafeSlice nL n2 notes), + V.ifilter (\i _ -> toneE i nL nL [0,2,4,6,8,10]) (V.unsafeSlice nL n2 notes)]) xs + | otherwise = Nothing +filterInParams (P3sf nT nL n2 xs) + | all (\n -> compare n 0 /= LT) [101 - nL,nT,nL,nT - nL,nL + 6 - nT] && n2 == 6 = + case xs of + "Dorian tetrachord" -> + if (nT - nL) `elem` [0,1,3,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,1,3,5]) (V.unsafeSlice nL 6 notes)) else Nothing + "Phrygian tetrachord" -> + if (nT - nL) `elem` [0,2,3,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,2,3,5]) (V.unsafeSlice nL 6 notes)) else Nothing + "Lydian tetrachord" -> + if (nT - nL) `elem` [0,2,4,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,2,4,5]) (V.unsafeSlice nL 6 notes)) else Nothing + _ -> Nothing + | all (\n -> compare n 0 /= LT) [94 - nL,nT,nL,nT - nL,nL + 13 - nT] && n2 == 13 = + getBFst' (Nothing, V.fromList . zip ["modern Aeolian mode", "modern Dorian mode", "modern Ionian mode", "modern Locrian mode", + "modern Lydian mode", "modern Mixolydian mode", "modern Phrygian mode"] $ fmap (h3 nT n2 nL) [[1,4,6,9,11], [1,4,6,8,11], [1,3,6,8,10], + [2,4,7,9,11], [1,3,5,8,10], [1,3,6,8,11], [2,4,6,9,11]]) xs + | otherwise = Nothing + +h3 :: Int -> Int -> Int -> [Int] -> Maybe (V.Vector Double) +h3 nT n2 nL zs + | nT == nL = Just (V.ifilter (\i _ -> toneD i nL nT zs) (V.unsafeSlice nL n2 notes)) + | otherwise = Nothing + +-- | For the list of @a@ from the @Ord@ class it builds a sorted in the ascending order list without duplicates. +-- +-- > sortNoDup [2,1,4,5,6,78,7,7,5,4,3,2,5,4,2,4,54,3,5,65,4,3,54,56,43,5,2] = [1,2,3,4,5,6,7,43,54,56,65,78] +-- +sortNoDup :: Ord a => [a] -> [a] +sortNoDup = sortNoDup' . sort + where sortNoDup' (x:x1@(y:_)) + | x == y = sortNoDup' x1 + | otherwise = x:sortNoDup' x1 + sortNoDup' (x:_) = [x] + sortNoDup' _ = [] + +-- | Checks whether its first 'Int' argument does not belong to those ones that are included into the list argument on the reminders basis. +-- The opposite to 'toneE' with the same arguments. +toneD :: Int -> Int -> Int -> [Int] -> Bool +toneD i nL nT zs = getBFst' (True,V.fromList . zip zs $ replicate 12 False) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) + +-- | Checks whether its first 'Int' argument does belong to those ones that are included into the list argument on the reminders basis. +-- The opposite to 'toneD' with the same arguments. +toneE :: Int -> Int -> Int -> [Int] -> Bool +toneE i nL nT zs = getBFst' (False,V.fromList . zip zs $ replicate 12 True) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) + +-- | Analogous to 'liftInEnku' lifts a frequency into a tonality (or something that can be treated alike one) specified by 'Params'. If not +-- reasonably one exists then the result is 11440 (Hz). +liftInParams :: Double -> Params -> Double +liftInParams x params + | lengthP params == 0 || (isNothing . whichOctaveG $ x) = 11440.0 + | otherwise = + V.unsafeIndex (fromJust . filterInParams $ params) (V.minIndex . V.map (abs . log . (\t -> t / x)) . V.generate (lengthP params) $ + (\i -> V.unsafeIndex notes (12 * fromJust (whichOctaveG x)) * 2 ** (fromIntegral i / fromIntegral (lengthP params)))) + +-- | Application of the 'liftInParams' to a 'V.Vector'. +liftInParamsV :: Params -> V.Vector Double -> V.Vector Double +liftInParamsV params = V.filter (/= 11440.0) . V.map (\x -> liftInParams x params) + +-- | Gets a length of the 'V.Vector' of 'Double' being represented as 'Params'. This is a number of the notes contained in the 'Params'. +lengthP :: Params -> Int +lengthP = fromMaybe 0 . fmap V.length . filterInParams + +-- | Check whether a given 'Double' value (frequency of a note) is in the vector of Doubles that corresponds to the given 'Params'. +elemP :: Double -> Params -> Bool +elemP note = fromMaybe False . fmap (note `V.elem`) . filterInParams + +-- | Check whether a given 'Double' value (frequency of the closest note to the given frequency) is in the vector of Doubles that +-- corresponds to the given 'Params'. +elemCloseP :: Double -> Params -> Bool +elemCloseP note = fromMaybe False . fmap (closestNote note `V.elem`) . filterInParams + +-- | A way to show not the (somewhat algebraic) structure of the 'Params' (as the usual 'show' does), but the contained frequencies in it. +showD :: Params -> String +showD = show . filterInParams + +-- | Check whether for the given arguments there are the notes and whether 'String' is a name signature for the scale in 'Params' (can they be used +-- together to correspond to a non-empty set of notes). +isStrParams :: String -> Params -> Bool +isStrParams xs (P2s x y zs) = if isJust (filterInParams (P2s x y zs)) then xs == zs else False +isStrParams xs (P3sf x y z zs) = if isJust (filterInParams (P3sf x y z zs)) then xs == zs else False +isStrParams xs (P4lsf x y z ts zs) = if isJust (filterInParams (P4lsf x y z ts zs)) then xs == zs else False +isStrParams xs (P32sf x y z zs ys) = if isJust (filterInParams (P32sf x y z zs ys)) then (xs == zs || xs == ys || xs == (ys ++ " " ++ zs)) else False +isStrParams _ _ = False + +-- | Check whether for the given arguments there are the notes and whether list of 'Int' is a part of the constructed 'Params' (can they be used +-- together to correspond to a non-empty set of notes). +isListParams :: [Int] -> Params -> Bool +isListParams xs (P4lsf x y z ts zs) = if isJust (filterInParams (P4lsf x y z ts zs)) then xs == ts else False +isListParams xs (P3lf x y zs) = if isJust (filterInParams (P3lf x y zs)) then xs == zs else False +isListParams _ _ = False + +-- | Generates melody for the given parameters. The idea is that every application of the function @f :: Double -> OvertonesO@ to its argument +-- possibly can produce multiple overtones being represented as 'V.Vector' of tuples of pairs of 'Double'. We can use the first element in the +-- tuple to obtain a new sound parameters and the second one -- to obtain its new duration in the melody. Additional function @g :: Double -> Double@ +-- is used to avoid the effect of becoming less and less -- closer to the zero for the higher overtones so the durations will become also less. +-- Besides it allows to rescale the durations in a much more convenient way. +-- +-- The first 'Double' parameter is a multiplication coefficient to increase or to decrease the durations (values with an absolute values greater than +-- one correspond to increasing inside the @g@. function applied afterwards with function composition and the values with an absolute values less +-- than one and not equal to zero correspond to decreasing inside the @g@ function. +-- The second 'Double' parameter is a usual frequency which is used instead of the 11440.0 (Hz) value. +-- The third 'Double' parameter is a main argument -- the frequency for which the 'OvertonesO' are generated as a first step of the computation. +overMeloPar :: (Double -> OvertonesO) -> (Double -> Double) -> Params -> Double -> Double -> Double -> IO () +overMeloPar f g params coeff freq0 freq = do + let v = f freq + vFreqs = V.map ((\z -> if z == 11440.0 then freq0 else z) . flip liftInParams params . fst) v + vD = V.map (g . (* coeff) . snd) v + v2 = V.map f vFreqs + vS = V.map (\z -> showFFloat (Just 4) (abs z) "") vD + h42 j (x,v3,y,ts) + | compare y 0.0 == GT = do + (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing (fst x) ""] "" + print herr + partialTest_k v3 0 ts + mixTest + renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav" + | compare y 0.0 == LT = do + (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"] "" + putStr herr + renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav" + | otherwise = putStrLn "Zero length of the sound! " + V.imapM_ (\j zz -> h42 j zz) . V.zip4 v v2 vD $ vS + +-- | A default way to get 'Durations' for the sounds up to 0.35.2.0 version of the package including. It is based on the number of Ukrainian +-- sounds representations (see, 'convertToProperUkrainian') in a Ukrainian syllables or somewhat generated by the same rules as they. +-- The rhythm using the function is very often not binary but its ratios are almost always a ratios of the small natural numbers (1, 2, 3, 4, 5, 6, 7 etc.). +str2DurationsDef :: Int -> String -> Double -> Durations +str2DurationsDef n zs y = + let (t, ws) = splitAt 1 . syllableStr n $ zs in V.map (\yy -> y * fromIntegral (yy * length ws) / fromIntegral (head t)) . V.fromList $ ws + +apply6GSilentFile :: FilePath -> Double -> Double -> IO () +apply6GSilentFile file limV vol = do + upp <- upperBnd file + ampL2 <- fmap ((\zz -> read zz::Double) . fst) (selMaxAbs file (0,upp)) + if compare (abs ampL2) (abs limV) /= GT then putStr "" + else apply6Gf vol file + +-- | Apply volume adjustment to the sound file. It must not be silent. Otherwise, it leads to likely noise sounding or errors. +apply6Gf :: Double -> FilePath -> IO () +apply6Gf vol file = soxE file ["norm","vol", showFFloat (Just 4) vol ""] + +-- | Function is used to generate a rhythm of the resulting file \'end.wav\' from the Ukrainian text and a number of sounds either in the syllables or in the words without vowels. +syllableStr :: Int -> String -> [Int] +syllableStr n xs = + let ps = take n . cycle . concat . sylLengthsP2 . syllablesUkrP $ xs + y = sum ps in + case y of + 0 -> [0] + _ -> y:ps + +-- | Similar to 'overSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller +-- by absolute value than 0.001. An 'Int' parameter is used to define an interval. To obtain compatible with versions prior to +-- 0.20.0.0 behaviour, use for the 'Int' 0. +-- +-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. +-- But for a lot of functions this works well. +-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_Sf'. +overSoXSynth2FDN_Sf :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO () +overSoXSynth2FDN_Sf f (x, y) = overSoXSynth2FDN_Sf3 f (x, y, 0.001) + +-- | Similar to 'overSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller +-- than the third 'Double' parameter by an absolute value in the triple of @Double@'s. An 'Int' parameter is used to define an interval. To obtain compatible +-- with versions prior to 0.20.0.0 behaviour, use for the 'Int' 0. +-- +-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function. +-- But for a lot of functions this works well. +-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_Sf3'. +overSoXSynth2FDN_Sf3 :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO () +overSoXSynth2FDN_Sf3 f (x, y, t0) j zs = overSoXSynth2FDN_Sf32G f (x, y, t0) j zs V.empty [] + +-- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter. +-- For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_Sf32G :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> V.Vector Double -> String -> IO () +overSoXSynth2FDN_Sf32G f (x, y, t0) j zs vdB ys + | V.null . convertToProperUkrainian $ zs = overSoXSynth x + | otherwise = do + let l0 = length zs + soundGenF32G (V.fromList [\x2 -> closestNote (if x2 /= 0.0 then abs x2 else V.unsafeIndex notes 0),\x2 -> fromMaybe (V.unsafeIndex notes 0) + (dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) (closestNote (if x2 /= 0.0 then abs x2 else V.unsafeIndex notes 0)))]) + (V.replicate 2 x) (V.fromList [1,V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))]) f (x, y, t0) j vdB ys + if null ys then mixTest else mixTest2G ys + +-- | Function is used to get numbers of intervals from a Ukrainian 'String'. It is used internally in the 'uniqOverSoXSynthN4' function. +intervalsFromString :: String -> Intervals +intervalsFromString = vStrToVIntG defInt . convertToProperUkrainian + +-- | Generatlized version of the 'vStrToVInt' with a possibility to specify your own 'Intervals'. +vStrToVIntG :: Intervals -> V.Vector String -> Intervals +vStrToVIntG v = V.map (strToIntG v) + +-- | Default values for 'strToInt'. All the intervals are not greater than one full octave. +defInt :: Intervals +defInt = V.fromList [12,4,7,3,4,5,5,12,3,8,12,7,10,7,7,7,12,10,7,10,2,12,2,2,11,11,1,12,9] +{-# INLINE defInt #-} + +-- | Generatlized version of the 'strToInt' with a possibility to specify your own 'Intervals'. +strToIntG :: Intervals -> String -> Int +strToIntG v = + getBFst' (0, V.zip (V.fromList ["а","б","в","г","д","дж","дз","е","ж","з","и","й","к","л","м","н","о","п","р","с","т","у","ф","х","ц","ч","ш", + "і","ґ"]) v) +{-# INLINE strToIntG #-} + +-- | Generalized variant of the 'soundGenF31G' with a possibility to specify sound quality using the 'String' argument. For more information, +-- please, refer to 'soxBasicParams'. +soundGenF32G :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> + V.Vector Double -> String -> IO () +soundGenF32G vf vd vi f (x, y, t0) j vdB ys = do + let vD = helpF1 vf vd vi -- Vector of notes played simultaneously (e. g. just one, interval, accord etc.) + vDz = V.mapMaybe id vD -- The previous one without Nothings and Justs + vNotes = doubleVecFromVecOfDouble f t0 (V.map Just vDz) -- Vector of vectors of pairs (freq,ampl) -- notes and their absence (V.empty) with overtones + ts = showFFloat (Just 4) (abs y) "" -- duration of the sound to be generated + V.imapM_ (\i _ -> do + _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ((if V.null vdB + then id else (\wwws -> adjust_dbVol wwws (V.unsafeIndex vdB i))) ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth",ts, + "sine", showFFloat Nothing (V.unsafeIndex vDz i) "","vol", if compare y 0.0 == GT then "1.0" else "0"])) "" + partialTest_k2G (V.unsafeIndex vNotes i) i ts vdB ys) vDz + +helpF0 :: Int -> String +helpF0 = + getBFst' ("ZZ0",V.fromList . zip [0..] $ (map (:[]) "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ++ concatMap (\z -> map ((z:) . (:[])) "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) + +helpF1 :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> V.Vector (Maybe Double) +helpF1 vf vd = + V.map (\(f1,x,i2) -> + case i2 of + 0 -> Nothing + _ -> Just $ f1 x) . V.zip3 vf vd + +-- | Generates a 'V.Vector' of 'OvertonesO' that represents the sound. +doubleVecFromVecOfDouble :: (Double -> OvertonesO) -> Double -> V.Vector (Maybe Double) -> V.Vector OvertonesO +doubleVecFromVecOfDouble f t0 = + V.map (\note1 -> if isNothing note1 then V.empty else V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f . fromJust $ note1) diff --git a/DobutokO/Sound/Functional/Split.hs b/DobutokO/Sound/Functional/Split.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Functional/Split.hs @@ -0,0 +1,175 @@ +-- | +-- Module : DobutokO.Sound.Functional.Split +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Functional.Split ( + -- * Splitting and concatenating OvertonesO + splitO + , splitO2 + , overConcat + -- ** Generalization of the previous ones splitting functions + , splitHelp1 + , splitHelp2 + , splitOG1 + , splitOG2 + , splitOG12 + , splitOG12S + , splitOG22 + , splitOG22S +) where + +import CaseBi (getBFst') +import Data.Char (isAsciiLower) +import Data.List (sortBy) +import qualified Data.Vector as V +import DobutokO.Sound.Functional.Basics + + +-- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number @n@ (specified by the first 'Int' argument) of 'OvertonesO' +-- (represented finally as a 'V.Vector' of them respectively) so that all except the first @n@ greatest by the absolute value of the amplitude +-- tuples of Doubles are considered overtones for the greatest by the absolute value one in the given 'OvertonesO' and all the next @n - 1@ +-- are treated as the greatest by the absolute value and each of them produces the similar by the @f :: Double -> OvertonesO@ function overtones. +-- +-- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar ones with different heights. +-- To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one. +splitO :: Int -> OvertonesO -> V.Vector OvertonesO +splitO n v0 + | compare (V.length v0) (n + 1) == GT = + let v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + (x0, y0) = V.unsafeIndex v1 0 + v2 = V.unsafeSlice 1 (n - 1) v1 + v31 = V.map (\t -> (fst t) / x0) v2 + v32 = V.map (\t -> (snd t) / y0) v2 + v3 = V.zip v31 v32 + f1Tup (t1, w2) = V.imap (\ i _ -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 + in V.map f1Tup (V.unsafeSlice 0 n v1) + | otherwise = V.singleton v0 + +-- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number of 'OvertonesO' (represented finally as a 'V.Vector' of them repsectively) +-- so that it intermediately uses a special function before applying the \"similarization\" splitting function. Is a generalization of the 'splitO', +-- which can be considered a 'splitO2' with a first command line argument equals to 'id'. +-- +-- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar (less or more, depending on @h :: OvertonesO -> OvertonesO@) +-- ones with different heights. To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one. +splitO2 :: (OvertonesO -> OvertonesO) -> Int -> OvertonesO -> V.Vector OvertonesO +splitO2 h n v0 + | compare (V.length v0) (n + 1) == GT = + let v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + (x0, y0) = V.unsafeIndex v1 0 + v2 = V.unsafeSlice 1 (n - 1) v1 + v31 = V.map (\t -> (fst t) / x0) v2 + v32 = V.map (\t -> (snd t) / y0) v2 + v3 = V.zip v31 v32 + f1Tup (t1, w2) = V.imap (\ i _ -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 + in V.map f1Tup (h . V.unsafeSlice 0 n $ v1) + | otherwise = V.singleton v0 + +-- | Generalized variant of the 'splitO' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument. +splitOG1 :: String -> Int -> OvertonesO -> V.Vector OvertonesO +splitOG1 xs n v0 + | compare (V.length v0) (n + 1) == GT = + let c1s = take 2 . filter isAsciiLower $ xs + v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + (x0, y0) = V.unsafeIndex v1 0 in + case c1s of + "ab" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,n - 1,V.length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,V.length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + "ad" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + _ -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + | otherwise = V.singleton v0 + +-- | Auxiliary function that is used inside 'splitOG1'. +splitHelp1 :: Int -> Int -> Int -> Int -> OvertonesO -> (Double,Double) -> V.Vector OvertonesO +splitHelp1 x1 x2 x3 x4 v00 (y5,y6) = + let v2 = V.unsafeSlice x1 x2 v00 + v31 = V.map (\t -> (fst t) / y5) v2 + v32 = V.map (\t -> (snd t) / y6) v2 + v3 = V.zip v31 v32 + f1Tup (t1, w2) = V.imap (\ i _ -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 + in V.map f1Tup (V.unsafeSlice x3 x4 v00) + +-- | Auxiliary function that is used inside 'splitOG2'. +splitHelp2 :: (OvertonesO -> OvertonesO) -> Int -> Int -> Int -> Int -> OvertonesO -> (Double,Double) -> V.Vector OvertonesO +splitHelp2 h1 x1 x2 x3 x4 v00 (y5,y6) = + let v2 = V.unsafeSlice x1 x2 v00 + v31 = V.map (\t -> (fst t) / y5) v2 + v32 = V.map (\t -> (snd t) / y6) v2 + v3 = V.zip v31 v32 + f1Tup (t1, w2) = V.imap (\ i _ -> (fst (V.unsafeIndex v3 i) * t1, snd (V.unsafeIndex v3 i) * w2)) v3 + in V.map f1Tup (h1 . V.unsafeSlice x3 x4 $ v00) + +-- | Generalized variant of the 'splitO2' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument. +splitOG2 :: (OvertonesO -> OvertonesO) -> String -> Int -> OvertonesO -> V.Vector OvertonesO +splitOG2 h xs n v0 + | compare (V.length v0) (n + 1) == GT = + let c1s = take 2 . filter isAsciiLower $ xs + v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + (x0, y0) = V.unsafeIndex v1 0 in + case c1s of + "ab" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,n - 1,V.length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,V.length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + "ad" -> let (k1,k2,k3,k4) = (n - 1,V.length v0 - n,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + _ -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + | otherwise = V.singleton v0 + +-- | Generalized variant of the 'splitOG1' with a possibility to specify a default value for splitting parameters as the first argument +-- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order 'V.Vector' (the second one). +-- Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. +splitOG12 :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> String -> Int -> OvertonesO -> V.Vector OvertonesO +splitOG12 (x1,x2,x3,x4) vf xs n v0 + | compare (V.length v0) (n + 1) == GT && not (V.null vf) = + let c1s = filter isAsciiLower $ xs + v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) vf) c1s in + splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + | otherwise = V.singleton v0 + +-- | Variant of the 'splitOG12' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument +-- then it is better to use 'splitOG12'. Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. +splitOG12S :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> String -> Int -> OvertonesO -> V.Vector OvertonesO +splitOG12S (x1,x2,x3,x4) vf xs n v0 + | compare (V.length v0) (n + 1) == GT && not (V.null vf) = + let c1s = filter isAsciiLower $ xs + v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + v2 = V.fromList . sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) . V.toList $ vf + (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) v2) c1s in + splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + | otherwise = V.singleton v0 + +-- | Generalized variant of the 'splitOG2' with a possibility to specify a default value for splitting parameters as the first argument +-- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order 'V.Vector' (the second one). +-- Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. +splitOG22 :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> (OvertonesO -> OvertonesO) -> String -> Int -> + OvertonesO -> V.Vector OvertonesO +splitOG22 (x1,x2,x3,x4) vf h xs n v0 + | compare (V.length v0) (n + 1) == GT && not (V.null vf) = + let c1s = filter isAsciiLower $ xs + v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) vf) c1s in + splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + | otherwise = V.singleton v0 + +-- | Variant of the 'splitOG22' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument +-- then it is better to use 'splitOG22'. Each 'String' in the 'V.Vector' must be unique and consist of lowercase ASCII letters. +splitOG22S :: (Int,Int,Int,Int) -> V.Vector (String,Int -> OvertonesO -> (Int,Int,Int,Int)) -> (OvertonesO -> OvertonesO) -> String -> Int -> + OvertonesO -> V.Vector OvertonesO +splitOG22S (x1,x2,x3,x4) vf h xs n v0 + | compare (V.length v0) (n + 1) == GT && not (V.null vf) = + let c1s = filter isAsciiLower $ xs + v1 = V.fromList . sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) . V.toList $ v0 + v2 = V.fromList . sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) . V.toList $ vf + (x0, y0) = V.unsafeIndex v1 0 in let (k1,k2,k3,k4) = getBFst' ((x1,x2,x3,x4),V.map (\(ys,g) -> (ys,g n v1)) v2) c1s in + splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + | otherwise = V.singleton v0 + +-- | Concatenates a 'V.Vector' of 'OvertonesO' into a single 'OvertonesO'. Can be easily used with 'splitO'. +overConcat :: V.Vector OvertonesO -> OvertonesO +overConcat = V.concat . V.toList diff --git a/DobutokO/Sound/IntermediateF.hs b/DobutokO/Sound/IntermediateF.hs --- a/DobutokO/Sound/IntermediateF.hs +++ b/DobutokO/Sound/IntermediateF.hs @@ -114,17 +114,15 @@ import Control.Exception (onException) import Control.Exception.FinalException (FinalException (NotRecorded,ExecutableNotProperlyInstalled),catchEnd) import Data.List (isPrefixOf,isSuffixOf,(\\),maximum,minimum) -import Data.Char (isDigit,isSpace) import qualified Data.Vector as V import System.Directory -import SoXBasics (playA,durationA,recA) +import SoXBasics (playA,durationA) import MMSyn7l import EndOfExe (showE) import System.Process (readProcessWithExitCode) import Data.Maybe (fromJust,isJust) import System.Exit (ExitCode (ExitSuccess)) import System.Info (os) -import DobutokO.Sound.ParseList (parseStoLInts) -- | Gets sizes of the \"result\*.wav\" files in the current directory. getFileRSizes :: IO (V.Vector Integer) diff --git a/DobutokO/Sound/Octaves.hs b/DobutokO/Sound/Octaves.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Octaves.hs @@ -0,0 +1,63 @@ +-- | +-- Module : DobutokO.Sound.Octaves +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Octaves ( + -- * Work with octaves + octaveUp + , octaveDown + , liftInOctave + , liftInOctaveV +) where + +import Data.Maybe (fromJust) +import qualified Data.Vector as V +import DobutokO.Sound.Functional.Basics + +-- | 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) + +-------------------------------------------------------------------------------------------------------------------------------- + diff --git a/DobutokO/Sound/Overtones.hs b/DobutokO/Sound/Overtones.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Overtones.hs @@ -0,0 +1,644 @@ +-- | +-- Module : DobutokO.Sound.Overtones +-- 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 #-} +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Overtones ( + -- * 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 + -- * Extended generation using enky functionality + -- ** With somewhat fixed timbre + , overSoXSynthNGenE + , overSoXSynthNGen2E + , overSoXSynthNGen3E + -- * New 4G functions to work with Durations + , overSoXSynthN4G + , overSoXSynthN24G + , overSoXSynthN34G + , overSoXSynthNGenE4G + , overSoXSynthNGen2E4G + , overSoXSynthNGen3E4G + -- ** 4G with speech-like composition + , overSoXSynthN4GS + , overSoXSynthN24GS + , overSoXSynthN34GS + , overSoXSynthNGenE4GS + , overSoXSynthNGen2E4GS + , overSoXSynthNGen3E4GS + -- * New 5G functions to work also with Intervals + , overSoXSynthN35G + , overSoXSynthNGen3E5G + -- ** 5G with obtained from the text arbitraty length Intervals + , overSoXSynthN35GS + , overSoXSynthNGen3E5GS + -- * New 6G function to work also with Strengths + , overSoXSynthNGen3E6G + -- ** 6G with obtained from the text arbitrary length Strengths + , overSoXSynthNGen3E6GS + , overSoXSynthNGen3E6GSu + -- * New generalized functions working with Params + , overSoXSynthNGenEPar + , overSoXSynthNGenE4GSPar + , overSoXSynthNGenE4GPar + , overSoXSynthNGen2EPar + , overSoXSynthNGen2E4GSPar + , overSoXSynthNGen2E4GPar + , overSoXSynthNGen3EPar + , overSoXSynthNGen3E4GSPar + , overSoXSynthNGen3E4GPar + , overSoXSynthNGen3E5GPar + , overSoXSynthNGen3E5GSPar + , overSoXSynthNGen3E6GPar + , overSoXSynthNGen3E6GSPar + , overSoXSynthNGen3E6GSuPar +) where + +import Numeric (showFFloat) +import Data.List (isPrefixOf,sort) +import Data.Maybe (isNothing,fromJust,maybe) +import qualified Data.Vector as V +import System.Process +import EndOfExe (showE) +import System.Directory +import Melodics.Ukrainian (convertToProperUkrainian) +import DobutokO.Sound.Functional.Basics +import DobutokO.Sound.Functional.Params +import DobutokO.Sound.DIS5G6G + +-- | 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)))) + +-- | 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) diff --git a/DobutokO/Sound/Process.hs b/DobutokO/Sound/Process.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Process.hs @@ -0,0 +1,272 @@ +-- | +-- Module : DobutokO.Sound.Process +-- 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. + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Process ( + -- * Basic functions for the executable + recAndProcess + , processD1 + , processD2 + , d3H + , d4H + , d5H + , d7H + , d8H + , d9H +) where + +import Data.List (isPrefixOf) +import CaseBi (getBFst') +import Numeric (showFFloat) +import Control.Exception (onException) +import Data.Maybe (fromJust) +import Data.Char (isDigit,isSpace) +import System.Process +import EndOfExe (showE) +import qualified Data.Vector as V (fromList) +import System.Directory +import SoXBasics +import Processing_mmsyn7ukr + +-- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing +-- whether there is no \"x.wav\" file in the current directory, because it can be overwritten. +recAndProcess :: FilePath -> Int -> IO String +recAndProcess file = + getBFst' (processD, V.fromList [(0,processD0 file),(1,processD1),(2,processD2 file),(3,processD3),(4,processD4),(5,processD5),(7,processD7), + (8,processD8),(9,processD9),(11,processD_1),(99,processD99),(999,processD99)]) + +processD_1 :: IO String +processD_1 = onException (do + putStr "Please, specify two \'Int\' numbers (with intermediate space character between them): the first one is a number of different notes there will be " + putStr "in the result, and the second one is a number of enky, to which you would like all the main components (not taking into account their " + putStr "respective lower bases of the intervals if any will exist) should belong. " + putStrLn "If you specify as the first one 2 (possibly the simplest case), then to the second one you can define a number in the range [3..53]. " + putStrLn "If you specify as the first one 3, then to the second one you can define a number in the range [2..35]. " + putStrLn "If you specify as the first one 4, then to the second one you can define a number in the range [2..26]. " + putStrLn "If you specify as the first one 6, then to the second one you can define a number in the range [1..17]. " + putStrLn "If you specify as the first one 9, then to the second one you can define a number in the range [1..11]. " + enka0 <- getLine + let enka1 = take 2 . words . filter (\x -> isDigit x || isSpace x) $ enka0 + enka2 = read (head . take 1 $ enka1)::Int + enka3 + | enka2 == 2 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 53) 3 == LT then 28 else (read (take 2 . head . tail $ enka1)::Int) + `rem` 53 + | enka2 == 3 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 35) 2 == LT then 19 else (read (take 2 . head . tail $ enka1)::Int) + `rem` 35 + | enka2 == 4 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 26) 2 == LT then 14 else (read (take 2 . head . tail $ enka1)::Int) + `rem` 26 + | enka2 == 6 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 17) 1 == LT then 9 else (read (take 2 . head . tail $ enka1)::Int) + `rem` 17 + | enka2 == 9 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 11) 1 == LT then 6 else (read (take 2 . head . tail $ enka1)::Int) + `rem` 11 + | otherwise = error "Not valid number in the second place. " + return $ show enka2 ++ " " ++ show enka3 ) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD3) +{-# INLINE processD_1 #-} + +processD0 :: FilePath -> IO String +processD0 file = onException (readProcessWithExitCode (fromJust (showE "sox")) [file, "x.wav", "-r22050", "channels", "1"] "" >> putStrLn "" >> return "") (do + exist <- doesFileExist "x.wav" + if exist then removeFile "x.wav" + else putStr "" + putStrLn "" + putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. " + putStrLn "Interrupt the program and start again with the valid file. " + putStrLn "_______________________________________________________________________" + processD0 file) +{-# INLINE processD0 #-} + +processD1 :: IO String +processD1 = onException (do + tempeRa 0 + putStrLn "Please, specify, how many seconds long sound data you would like to record." + time <- getLine + let time0 = read (filter (\t -> isDigit t || t == '.') time)::Double + putStrLn "Please, wait for 0.5 second and produce the needed sound now." + recA "x.wav" time0 + putStrLn "" + return "") (do + dir0 <- listDirectory "." + let paths5 = filter (isPrefixOf "nx.") dir0 + paths6 = filter (== "x.wav") dir0 + paths = paths5 ++ paths6 + mapM_ removeFile paths + putStrLn "" + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD1) +{-# INLINE processD1 #-} + +processD2 :: FilePath -> IO String +processD2 file = onException (do + exist3 <- doesFileExist file + if exist3 then return "" + else do + putStr "Please, specify the control parameter for the SoX \"noisered\" effect in the range from 0.0 to 1.0. " + putStrLn "The greater value causes more reduction with possibly removing some important sound data. The default value is 0.5 " + putStrLn "To use the default value, you can simply press Enter." + ctrlN <- getLine + let addit = dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN + noiseP = if null ctrlN then "" + else tail addit + controlNoiseReduction $ '0':noiseP + norm "_x.wav" + if "nx." `isPrefixOf` file + then putStr "" + else renameFile "8_x.wav" file + removeFile "x.wav" + removeFile "_x.wav" + dir <- listDirectory "." + let paths4 = filter (isPrefixOf "nx.") dir + mapM_ removeFile paths4 + putStrLn "" + return "") (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD2 file) +{-# INLINE processD2 #-} + +processD3 :: IO String +processD3 = onException (do + putStr "Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) " + putStrLn "should belong. The number should be better in the range [1..8]" + fmap d3H getLine) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD3) +{-# INLINE processD3 #-} + +d3H :: String -> String +d3H xs = show $ (read (take 1 xs)::Int) `rem` 9 +{-# INLINE d3H #-} + +processD4 :: IO String +processD4 = onException (do + putStr "Please, specify the amplitude for the generated overtones as an Int number in the range [0..99]. " + putStrLn "The default one is 99" + putStrLn "To use the default value, you can simply press Enter." + fmap d4H getLine) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD4) +{-# INLINE processD4 #-} + +d4H :: String -> String +d4H xs + | null xs = "1.0" + | otherwise = let amplOb = (read (take 2 . filter isDigit $ xs)::Int) `rem` 100 in + case amplOb of + 99 -> "1.0" + _ -> if compare (amplOb `quot` 9) 1 == LT then "0.0" ++ show (amplOb + 1) + else "0." ++ show (amplOb + 1) +{-# INLINE d4H #-} + +processD5 :: IO String +processD5 = onException (do + putStr "Please, specify the basic duration for the generated sounds as a Double number in the range [0.1..4.0]. " + putStrLn "The default one is 0.5" + putStrLn "To use the default value, you can simply press Enter." + fmap d5H getLine) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD5) +{-# INLINE processD5 #-} + +d5H :: String -> String +d5H xs + | null xs = "0.5" + | otherwise = let time1 = (read (filter (\z -> isDigit z || z == '.') xs)::Double) in + if compare time1 0.1 /= LT && compare time1 4.0 /= GT then showFFloat (Just 4) time1 $ show 0 + else let mantissa = time1 - (fromIntegral . truncate $ time1) + ceilP = (truncate time1::Int) `rem` 4 in + if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0) + else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0) +{-# INLINE d5H #-} + +processD7 :: IO String +processD7 = onException (do + putStrLn "Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: " + fmap d7H getLine) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD7) +{-# INLINE processD7 #-} + +d7H :: String -> String +d7H xs + | null xs = "або" + | otherwise = xs +{-# INLINE d7H #-} + +processD8 :: IO String +processD8 = onException (do + putStr "Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. " + putStrLn "The number is in the range [0.1..2.0]. The default one is 1.0" + putStrLn "To use the default value, you can simply press Enter." + fmap d8H getLine) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD8) +{-# INLINE processD8 #-} + +d8H :: String -> String +d8H xs + | null xs = "1.0" + | otherwise = let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') xs)::Double) in + if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then showFFloat (Just 4) dAmpl1 $ show 0 + else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1) + ceilP = (truncate dAmpl1::Int) `rem` 2 in + if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0) + else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0) +{-# INLINE d8H #-} + +processD9 :: IO String +processD9 = onException (do + putStrLn "Please, input the Ukrainian text that will be used to define the intervals to be used to produce the lower note for the given main one. " + putStrLn "The default one is \"й\". " + putStrLn "To use the default value, you can simply press Enter." + fmap d9H getLine) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD9) +{-# INLINE processD9 #-} + +d9H :: String -> String +d9H xs + | null xs = "й" + | otherwise = xs +{-# INLINE d9H #-} + +processD :: IO String +processD = onException (do + putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: " + getLine) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD) +{-# INLINE processD #-} + +processD99 :: IO String +processD99 = onException (do + putStr "Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indices for the files to be played " + putStr "with SoX effects applied to. The lists must be separated with newline (just press \"Enter\"), empty lists are ignored. If index is an " + putStrLn "element of several input lists then if its number of occurrences in all the lists is odd, then it is played, otherwise it is not. " + putStrLn "To end the input, just press the combination that means the end of input (e. g. for Unices, it's probably Ctrl + D). " + getContents) (do + putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested." + putStrLn "_______________________________________________________________________" + processD) +{-# INLINE processD99 #-} + +---------------------------------------------------------------------------------------------- + diff --git a/DobutokO/Sound/Uniq.hs b/DobutokO/Sound/Uniq.hs new file mode 100644 --- /dev/null +++ b/DobutokO/Sound/Uniq.hs @@ -0,0 +1,691 @@ +-- | +-- Module : DobutokO.Sound.Uniq +-- 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 #-} +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Uniq ( + -- * Library and executable functions + -- ** 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 + -- * Extended generation using enky functionality + -- ** With usage of additional information in the Ukrainian text + , uniqOverSoXSynthNGenE + , uniqOverSoXSynthNGen3E + , uniqOverSoXSynthNGen4E + -- * New 4G functions to work with Durations + , uniqOverSoXSynthN4G + , uniqOverSoXSynthN34G + , uniqOverSoXSynthN44G + , uniqOverSoXSynthNGenE4G + , uniqOverSoXSynthNGen3E4G + , uniqOverSoXSynthNGen4E4G + -- ** 4G with speech-like composition + , uniqOverSoXSynthN4GS + , uniqOverSoXSynthN34GS + , uniqOverSoXSynthN44GS + , uniqOverSoXSynthNGenE4GS + , uniqOverSoXSynthNGen3E4GS + , uniqOverSoXSynthNGen4E4GS + -- * New 5G functions to work also with Intervals + , uniqOverSoXSynthN45G + , uniqOverSoXSynthNGen4E5G + -- ** 5G with obtained from the text arbitraty length Intervals + , uniqOverSoXSynthN45GS + , uniqOverSoXSynthNGen4E5GS + -- * New 6G function to work also with Strengths + , uniqOverSoXSynthNGen4E6G + -- ** 6G with obtained from the text arbitrary length Strengths + , uniqOverSoXSynthN46GS + , uniqOverSoXSynthN46GSu + , uniqOverSoXSynthNGen4E6GS + , uniqOverSoXSynthNGen4E6GSu + -- ** With overtones obtained from the additional Ukrainian text + , uniqOverSoXSynthNGenEPar + , uniqOverSoXSynthNGenE4GSPar + , uniqOverSoXSynthNGenE4GPar + , uniqOverSoXSynthNGen3EPar + , uniqOverSoXSynthNGen3E4GSPar + , uniqOverSoXSynthNGen3E4GPar + , uniqOverSoXSynthNGen4EPar + , uniqOverSoXSynthNGen4E4GSPar + , uniqOverSoXSynthNGen4E4GPar + , uniqOverSoXSynthNGen4E5GPar + , uniqOverSoXSynthNGen4E5GSPar + , uniqOverSoXSynthNGen4E6GPar + , uniqOverSoXSynthNGen4E6GSPar + , uniqOverSoXSynthNGen4E6GSuPar +) where + +import Numeric (showFFloat) +import Data.Maybe (isNothing,fromJust) +import qualified Data.Vector as V +import System.Process +import EndOfExe (showE) +import MMSyn7s +import DobutokO.Sound.Functional.Basics +import DobutokO.Sound.Functional.Params +import DobutokO.Sound.DIS5G6G + +-- | 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 + +-- | 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 + +-- | 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 diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -279,3 +279,10 @@ a special reencoding using lazy bytestrings. For more information, please, refer to DobutokO.Sound.Keyboard module. +Since 0.41.0.0 version the module structure is completely changed: there were added +new ones and rearranged the existing, module DobutokO.Sound splitted into three +different modules: DobutokO.Sound.Overtones, DobutokO.Sound.Uniq and +DobutokO.Sound.Octaves. This was done to simplify compilation and to produce more +logical and semantic structure. The most complicated functions from +DobutokO.Sound.Functional module are moved to a new package dobutokO3. Some code +improvements. diff --git a/dobutokO2.cabal b/dobutokO2.cabal --- a/dobutokO2.cabal +++ b/dobutokO2.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: dobutokO2 -version: 0.40.0.0 +version: 0.41.0.0 synopsis: Helps to create experimental music from a file (or its part) and a Ukrainian text. description: It can also generate a timbre for the notes. Uses SoX inside. homepage: https://hackage.haskell.org/package/dobutokO2 @@ -17,7 +17,7 @@ cabal-version: >=1.10 library - exposed-modules: Main, DobutokO.Sound, DobutokO.Sound.Functional, DobutokO.Sound.Executable, DobutokO.Sound.IntermediateF, DobutokO.Sound.ParseList, DobutokO.Sound.Keyboard + exposed-modules: Main, DobutokO.Sound.Overtones, DobutokO.Sound.Uniq, DobutokO.Sound.Functional, DobutokO.Sound.Process, DobutokO.Sound.Executable, DobutokO.Sound.IntermediateF, DobutokO.Sound.ParseList, DobutokO.Sound.Keyboard, DobutokO.Sound.Functional.Basics, DobutokO.Sound.Functional.Params, DobutokO.Sound.Functional.Split, DobutokO.Sound.DIS5G6G, DobutokO.Sound.Functional.Elements, DobutokO.Sound.Decibel, DobutokO.Sound.Extended, DobutokO.Sound.Octaves, DobutokO.Sound.FunctionF -- other-modules: -- other-extensions: build-depends: base >=4.7 && <4.15, bytestring >= 0.10.6 && <1, vector >=0.11 && <0.14, process >=1.4 && <1.9, mmsyn3 >=0.1.5 && <1, mmsyn7s >=0.6.7 && <1, directory >=1.2.7 && <1.7, mmsyn7ukr >=0.15.4 && <1, mmsyn2 >=0.1.8 && <1, mmsyn6ukr >=0.7.2 && <1, mmsyn7l >=0.5 && <1