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