-- | -- Module : DobutokO.Sound.Functional -- 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.Functional ( -- * 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 , 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 ) 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 MMSyn7.Syllable 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) -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 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 -- | 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.057098), ("в", 0.082268), ("г", 0.076825), ("д", 0.072063), ("дж", 0.048934), ("дз", 0.055601), ("е", 0.093605), ("ж", 0.070612), ("з", 0.056054), ("и", 0.099955), ("й", 0.057143), ("к", 0.045397), ("л", 0.064036), ("м", 0.077370), ("н", 0.074240), ("о", 0.116463), ("п", 0.071837), ("р", 0.049206), ("с", 0.074603), ("сь", 0.074558), ("т", 0.110658), ("у", 0.109070), ("ф", 0.062268), ("х", 0.077188), ("ц", 0.053061), ("ць", 0.089342), ("ч", 0.057551), ("ш", 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.718872), ("в", (-0.630859)), ("г", (-0.757599)), ("д", (-0.624176)), ("дж", 0.768127), ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.837921)), ("з", (-0.528870)), ("и", (-0.770935)), ("й", (-0.708008)), ("к", 0.886139), ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", (-0.212402)), ("р", 0.651062), ("с", 0.155640), ("сь", (-0.207764)), ("т", 0.304413), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)), ("ць", 0.381348), ("ч", 0.242615), ("ш", 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.718872), ("в", (-0.630859)), ("г", (-0.757599)), ("д", (-0.624176)), ("дж", 0.768127), ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.837921)), ("з", (-0.528870)), ("и", (-0.770935)), ("й", (-0.708008)), ("к", 0.886139), ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", (-0.212402)), ("р", 0.651062), ("с", 0.155640), ("сь", (-0.207764)), ("т", 0.304413), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)), ("ць", 0.381348), ("ч", 0.242615), ("ш", 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