dobutokO2-0.30.0.0: DobutokO/Sound/Functional.hs
-- |
-- Module : DobutokO.Sound.Functional
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- A program and a library to create experimental music
-- from a mono audio and a Ukrainian text.
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module DobutokO.Sound.Functional (
-- * Type synonyms with different semantics
SoundsO
, OvertonesO
, NotePairs
-- * Work with notes (general)
, notes
, neighbourNotes
, closestNote
, pureQuintNote
, overTones
-- * Work with enky (extension to octaves functionality)
, nkyT
, whichEnka
, enkuUp
, enkuDown
, liftInEnkuV
, liftInEnku
-- ** Work with octaves
, octavesT
-- * Combining intermediate files
, mixTest
, mixTest2
-- * Working with files
, freqsFromFile
, endFromResult
-- * Work with overtones
, overSoXSynth
-- * Use additional function as a parameter
, overSoXSynth2FDN
, overSoXSynth2FDN_B
-- ** Just simple function application
, overSoXSynth2FDN_S
-- *** With additional filtering
, overSoXSynth2FDN_Sf
, overSoXSynth2FDN_Sf3
-- * Use additional function and Ukrainian texts and generates melody
, overSoXSynthGen2FDN
, overSoXSynthGen2FDN_B
, overSoXSynthGen2FDN_S
, overSoXSynthGen2FDN_Sf
, overSoXSynthGen2FDN_Sf3
, dNote
-- * 1G generalized functions with dB volume overtones adjustments
, overSoXSynth2FDN1G
, overSoXSynth2FDN_B1G
, overSoXSynth2FDN_S1G
, overSoXSynth2FDN_Sf1G
, overSoXSynth2FDN_Sf31G
, partialTest_k1G
-- * 2G generalized functions with additional sound quality specifying
, overSoXSynth2FDN2G
, overSoXSynth2FDN_B2G
, overSoXSynth2FDN_S2G
, overSoXSynth2FDN_Sf2G
, overSoXSynth2FDN_Sf32G
, partialTest_k2G
, soundGenF32G
-- ** 2G generalized functions for melody producing
, overSoXSynthGen2FDN_SG2G
, overSoXSynthGen2FDN_Sf3G2G
-- ** 2G generalized auxiliary functions
, mixTest2G
, mixTest22G
, endFromResult2G
-- * Generalized functions with several functional parameters
, soundGenF3
, overSoXSynthGen2FDN_SG
, overSoXSynthGen2FDN_Sf3G
-- ** 1G generalized function with db volume overtones adjustments and several functional parameters
, soundGenF31G
-- ** Auxiliary functions
, soxBasicParams
, adjust_dbVol
, partialTest_k
, prependZeroes
, nOfZeroesLog
, numVZeroesPre
, syllableStr
, intervalsFromString
, vStrToVInt
, strToInt
, doubleVecFromVecOfDouble
, helpF1
, helpF0
-- * 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
, gAdd01
, gAdd02
, gAdd03
, gAdd04
, gRem01
, gRem02
, gRem03
-- ** Working with two OvertonesO
, fAddFElems
, fRemoveFElems
, freqsOverlapOvers
, elemsOverlapOvers
, gAdds01
, gAdds02
) where
import Text.Read (readMaybe)
import CaseBi (getBFst')
import Data.Char (isDigit)
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)
import MMSyn7.Syllable
-- | 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)
-- | 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"]
-- | Is used internally in the functions to specify different SoX parameters for the sound synthesis (rate, bit depth and file extension). Possible
-- file extensions are: ".wav" (a default one) and ".flac" (being lossless compressed); rates -- 8000, 11025, 16000, 22050 (a default one), 32000,
-- 44100, 48000, 88200, 96000, 176400, 192000 Hz; bit depths -- 16 bits and 24 bits. The first two digits in a 'String' argument encodes rate,
-- the next one -- bit depth and the last symbol -- letter \'w\' or \'f\' -- file extension. Because of SoX uses FLAC optionally, before use it, please,
-- check whether your installation supports it.
soxBasicParams :: String -> [String] -> [String]
soxBasicParams ys xss
| null xss = []
| otherwise =
let (ts,zs) = splitAt 2 . init $ ys in (getBFst' ("-r22050",V.fromList . zip ["11","16", "17", "19", "32", "44", "48", "80", "96"] $
["-r11025","-r16000","-r176400","-r192000","-r32000","-r44100","-r48000","-r8000","-r96000"]) ts) : (if zs == "2" then "-b24" else "-b16") :
((if drop 3 ys == "f" then map (\xs -> if drop (length xs - 4) xs == ".wav" then take (length xs - 4) xs ++ ".flac" else xs) else id) . tail $ xss)
-- | '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
| 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 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""] "") vec
overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""] (V.unsafeIndex vdB i)) "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine", showFFloat Nothing note0 ""] ""
if isNothing note1 then overSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", showFFloat Nothing (fromJust note1) ""] ""
overSoXSynthHelp v0
overSoXSynthHelp2 v1 vdB
mixTest
-- | Similar to 'overSoXSynth2FDN1G', but additionally allows to specify by the second 'String' argument a quality changes to the generated files
-- (please, see 'soxBasicParams').
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 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(soxBasicParams ys ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""]) "") vec
overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""] (V.unsafeIndex vdB i))) "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testA.wav", "synth", ts, "sine",
showFFloat Nothing note0 ""]) ""
if isNothing note1 then overSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testB.wav", "synth", ts, "sine",
showFFloat Nothing (fromJust note1) ""]) ""
overSoXSynthHelp v0
overSoXSynthHelp2 v1 vdB
mixTest2G ys
-- | 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
-- | 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 = sort . 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 = sort . 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 = sort . 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 = sort . 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 =
let zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 50 == 0
then do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""] ""
path1s <- listDirectory "."
let path2s = sort . filter (isPrefixOf $ "test" ++ show k) $ path1s
(code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["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)) ++ ".wav"
if exi then putStrLn ("DobutokO.Sound.Functional.partialTest_k: " ++ herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ ".wav")
else putStrLn $ "DobutokO.Sound.Functional.partialTest_k: " ++ herr0
else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""] "" >> putStr "") vec
-- | 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 =
let zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 50 == 0
then do
_ <- readProcessWithExitCode (fromJust (showE "sox")) (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 ++ ["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)) ++ ".wav"
if exi then putStrLn ("DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ ".wav")
else putStrLn $ "DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0
else readProcessWithExitCode (fromJust (showE "sox")) (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)) "" >> putStr "") vec
-- | 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 ("DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav")
else putStrLn $ "DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0
else 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))) "" >> 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
| 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 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""] "") vec
overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""] (V.unsafeIndex vdB i))"") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] ""
if isNothing note1 then overSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", ts,"sine",showFFloat Nothing (fromJust note1) ""] ""
overSoXSynthHelp v0
overSoXSynthHelp2 v1 vdB
mixTest
-- | 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 vec = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(soxBasicParams ys ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""]) "") vec
overSoXSynthHelp2 vec vdB = V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "",
"vol", showFFloat Nothing amplN ""] (V.unsafeIndex vdB i))) "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testA.wav", "synth", ts,"sine",
showFFloat Nothing note0 ""]) ""
if isNothing note1 then overSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testB.wav", "synth", ts,"sine",
showFFloat Nothing (fromJust note1) ""]) ""
overSoXSynthHelp v0
overSoXSynthHelp2 v1 vdB
mixTest2G ys
-- | 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
| 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")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] ""
if isNothing note1 then partialTest_k v0 0 ts
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", ts,"sine", showFFloat Nothing (fromJust note1) ""] ""
partialTest_k v0 0 ts
partialTest_k v1 1 ts
mixTest
-- | 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
| 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")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] ""
if isNothing note1 then partialTest_k1G v0 0 ts vdB
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", ts,"sine",showFFloat Nothing (fromJust note1) ""] ""
partialTest_k1G v0 0 ts vdB
partialTest_k1G v1 1 ts vdB
mixTest
-- | 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")) (soxBasicParams ys ["-r22050", "-n", "testA.wav", "synth", ts,"sine",
showFFloat Nothing note0 ""]) ""
if isNothing note1 then partialTest_k2G v0 0 ts vdB ys
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["-r22050", "-n", "testB.wav", "synth", ts,"sine",
showFFloat Nothing (fromJust note1) ""]) ""
partialTest_k2G v0 0 ts vdB ys
partialTest_k2G v1 1 ts vdB ys
mixTest2G ys
-- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function.
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
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws 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 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'.
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
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws 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.
overSoXSynthGen2FDN_Sf :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO ()
overSoXSynthGen2FDN_Sf file m ku f y zs wws = do
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws 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
| V.null . convertToProperUkrainian $ zs = overSoXSynth x
| otherwise = do
let l0 = length zs
soundGenF3 (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 zs
mixTest
-- | 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
| V.null . convertToProperUkrainian $ zs = overSoXSynth x
| otherwise = do
let l0 = length zs
soundGenF31G (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 zs vdB
mixTest
-- | 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 zs vdB ys
mixTest2G ys
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 ->
String -> IO ()
soundGenF3 vf vd vi f (x, y, t0) j zs = 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
l0 = length zs
ts = showFFloat (Just 4) (abs y) "" -- duration of the sound to be generated
V.imapM_ (\i note1 -> do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth", ts,"sine",
showFFloat Nothing (V.unsafeIndex vDz i) ""] ""
partialTest_k (V.unsafeIndex vNotes i) i ts) vDz
-- | 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 ->
String -> V.Vector Double -> IO ()
soundGenF31G vf vd vi f (x, y, t0) j zs vdB = 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
l0 = length zs
ts = showFFloat (Just 4) (abs y) "" -- duration of the sound to be generated
V.imapM_ (\i note1 -> do
_ <- readProcessWithExitCode (fromJust (showE "sox")) (adjust_dbVol ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth", ts, "sine",
showFFloat Nothing (V.unsafeIndex vDz i) ""] (V.unsafeIndex vdB i)) ""
partialTest_k1G (V.unsafeIndex vNotes i) i ts vdB) vDz
-- | Generalized variant of the 'soundGenF31G' with a possibility to specify sound quality using the second '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 ->
String -> V.Vector Double -> String -> IO ()
soundGenF32G vf vd vi f (x, y, t0) j zs 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
l0 = length zs
ts = showFFloat (Just 4) (abs y) "" -- duration of the sound to be generated
V.imapM_ (\i note1 -> do
_ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth",ts,
"sine", showFFloat Nothing (V.unsafeIndex vDz i) ""] (V.unsafeIndex vdB i))) ""
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.
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
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws 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'.
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
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws 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@.
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 -> V.Vector Int
intervalsFromString = vStrToVInt . convertToProperUkrainian
vStrToVInt :: V.Vector String -> V.Vector Int
vStrToVInt = V.map strToInt
strToInt :: String -> Int
strToInt =
getBFst' (0, 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 strToInt #-}
-- | 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 vec = 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 ""] "") vec
overSoXSynthHelp2 vec = 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 ""] "") vec
_ <- 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'. Unlike for 'sameFreqF', it depends also on the 'Double' argument for @f :: Double -> OvertonesO@. 'fAddFElem' is
-- actually a higher-order function, it changes the function @f@ (in some point) and returns the new one. It can be 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 reproduce rather complex behaviour.
fAddFElem :: (Double, Double) -> Double -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fAddFElem (noteN,amplN) freq 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'. Unlike for 'sameFreqF', it depends also on the 'Double' argument for @f :: Double -> OvertonesO@. 'fRemoveFElem' is
-- actually a higher-order function, it changes the function @f@ (in some point) and returns the 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 reproduce rather complex behaviour.
fRemoveFElem :: (Double, Double) -> Double -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fRemoveFElem (noteN,amplN) freq f gRem = \t -> gRem (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 f = renormFD amplMax . gAdd01 (note,ampl) freq $ f
-- | 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 f = renormFD amplMax . gAdd01 (note,ampl) freq $ f
-- | 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 -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fAddFElems v freq 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 -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fRemoveFElems v freq f gRems = \t -> gRems 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 = (fst . break (/= head ys) $ ys):h (snd . break (/= head ys) $ ys)
h1 ys = map (\zs -> (sum . map snd $ zs) / fromIntegral (length zs)) . h $ ys
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 f = renormFD amplMax . gAdds01 v0 freq $ f
-- | 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