{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module DobutokO.Sound.Functional (
SoundsO
, OvertonesO
, NotePairs
, Durations
, Strengths
, StrengthsDb
, Intervals
, notes
, neighbourNotes
, closestNote
, pureQuintNote
, overTones
, nkyT
, whichEnka
, enkuUp
, enkuDown
, liftInEnkuV
, liftInEnku
, octavesT
, mixTest
, mixTest2
, freqsFromFile
, endFromResult
, overSoXSynth
, overSoXSynth2FDN
, overSoXSynth2FDN_B
, overSoXSynth2FDN_S
, overSoXSynth2FDN_Sf
, overSoXSynth2FDN_Sf3
, overSoXSynthGen2FDN
, overSoXSynthGen2FDN_B
, overSoXSynthGen2FDN_S
, overSoXSynthGen2FDN_Sf
, overSoXSynthGen2FDN_Sf3
, dNote
, overSoXSynth2FDN1G
, overSoXSynth2FDN_B1G
, overSoXSynth2FDN_S1G
, overSoXSynth2FDN_Sf1G
, overSoXSynth2FDN_Sf31G
, partialTest_k1G
, overSoXSynth2FDN2G
, overSoXSynth2FDN_B2G
, overSoXSynth2FDN_S2G
, overSoXSynth2FDN_Sf2G
, overSoXSynth2FDN_Sf32G
, partialTest_k2G
, soundGenF32G
, overSoXSynthGen2FDN_SG2G
, overSoXSynthGen2FDN_Sf3G2G
, mixTest2G
, mixTest22G
, endFromResult2G
, soundGenF3
, overSoXSynthGen2FDN_SG
, overSoXSynthGen2FDN_Sf3G
, soundGenF31G
, adjust_dbVol
, partialTest_k
, prependZeroes
, nOfZeroesLog
, numVZeroesPre
, syllableStr
, helpF1
, helpF0
, doubleVecFromVecOfDouble
, intervalsFromString
, vStrToVInt
, strToInt
, maybeFFromStrVec
, fVecCoefs
, showFFromStrVec
, renormF
, renormFD
, sameOvertone
, sameOvertoneL
, sameFreqF
, sameFreqFI
, fAddFElem
, fRemoveFElem
, fChangeFElem
, gAdd01
, gAdd02
, gAdd03
, gAdd04
, gRem01
, gRem02
, gRem03
, fAddFElems
, fRemoveFElems
, fChangeFElems
, freqsOverlapOvers
, elemsOverlapOvers
, gAdds01
, gAdds02
, splitO
, splitO2
, overConcat
, splitHelp1
, splitHelp2
, splitOG1
, splitOG2
, splitOG12
, splitOG12S
, splitOG22
, splitOG22S
, duration1000
, durationsAver
, str2Durat1
, str2Durations
, str2DurationsDef
, str2Vol1
, str2Volume
, defInt
, doublesAveragedA
, doublesAveragedG
, equalize2Vec
, intervalsFromStringG
, overSoXSynthGen2FDN4G
, overSoXSynthGen2FDN_SG4GS
, silentSound2G
, strToIntG
, strengthsAver
, strengthsDbAver
, vStrToVIntG
, overSoXSynth2FDN5G
, overSoXSynth2FDN_B5G
, overSoXSynth2FDN_S5G
, overSoXSynth2FDN_Sf35G
, apply6Gf
, apply6G
, apply6G2
, apply6GS
, apply6GS2
, apply6GSilentFile
, overSoXSynth2FDN6G
, overSoXSynth2FDN6GS
, overSoXSynth2FDN_B6G
, overSoXSynth2FDN_B6GS
, overSoXSynth2FDN_S6G
, overSoXSynth2FDN_S6GS
, overSoXSynth2FDN_Sf36G
, overSoXSynth2FDN_Sf36GS
, overSoXSynthGen2FDN_SG6G
, overSoXSynthGen2FDN_SG6GS
) where
import Text.Read (readMaybe)
import CaseBi (getBFst')
import Data.Char (isDigit,isAsciiLower)
import System.Exit (ExitCode( ExitSuccess ))
import Numeric
import Data.List (isPrefixOf,sort,sortBy,nubBy)
import Data.Maybe (isNothing,fromJust,isJust,fromMaybe,maybe)
import qualified Data.Vector as V
import System.Process
import EndOfExe
import System.Directory
import Melodics.Ukrainian (convertToProperUkrainian)
import SoXBasics (durationA,upperBnd,selMaxAbs)
import MMSyn7.Syllable
import DobutokO.Sound.IntermediateF
type SoundsO = V.Vector (Double, Double)
type OvertonesO = V.Vector (Double, Double)
type NotePairs = V.Vector (Double, Double)
type Durations = V.Vector Double
type Strengths = V.Vector Double
type StrengthsDb = V.Vector Double
type Intervals = V.Vector Int
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)
adjust_dbVol :: [String] -> Double -> [String]
adjust_dbVol xss y
| y == 0.0 = xss
| otherwise = xss ++ ["vol",showFFloat Nothing y "dB"]
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 []
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
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
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 ""
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)
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
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
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 })
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
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
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
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
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."
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."
partialTest_k :: OvertonesO -> Int -> String -> IO ()
partialTest_k vec k ts = partialTest_k2G vec k ts V.empty []
partialTest_k1G :: OvertonesO -> Int -> String -> V.Vector Double -> IO ()
partialTest_k1G vec k ts vdB = partialTest_k2G vec k ts vdB []
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
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)
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)
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 []
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
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
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 ""
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)
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
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 []
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 []
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
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
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 ""
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)
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
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
duration1000 :: FilePath -> IO Int
duration1000 file = fmap (\t -> truncate (t / 0.001)) . durationA $ file
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)
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
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)
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
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
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
overSoXSynth2FDN_Sf :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()
overSoXSynth2FDN_Sf f (x, y) = overSoXSynth2FDN_Sf3 f (x, y, 0.001)
overSoXSynth2FDN_Sf1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO ()
overSoXSynth2FDN_Sf1G f (x, y) = overSoXSynth2FDN_Sf31G f (x, y, 0.001)
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)
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
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 []
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 []
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
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
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 ""
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"))
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 []
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 []
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
vDz = V.mapMaybe id vD
ilDz = V.length vDz - 1
vNotes = doubleVecFromVecOfDouble f t0 (V.map Just vDz)
ts = showFFloat (Just 4) (abs y) ""
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
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
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
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
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))
notes :: V.Vector Double
notes = V.generate 108 (\t -> 440 * 2 ** (fromIntegral (t - 57) / 12))
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))
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
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 #-}
numVZeroesPre :: V.Vector a -> Int
numVZeroesPre v = fromMaybe (0 :: Int) (nOfZeroesLog . V.length $ v)
{-# INLINE numVZeroesPre #-}
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
liftInEnkuV :: Int -> Int -> V.Vector Double -> V.Vector Double
liftInEnkuV n ku = V.mapMaybe (liftInEnku n ku)
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
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
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 #-}
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 #-}
intervalsFromString :: String -> Intervals
intervalsFromString = vStrToVIntG defInt . convertToProperUkrainian
intervalsFromStringG :: Intervals -> String -> Intervals
intervalsFromStringG v = vStrToVIntG v . convertToProperUkrainian
vStrToVInt :: V.Vector String -> Intervals
vStrToVInt = V.map (strToIntG defInt)
vStrToVIntG :: Intervals -> V.Vector String -> Intervals
vStrToVIntG v = V.map (strToIntG v)
strToInt :: String -> Int
strToInt = strToIntG defInt
{-# INLINE strToInt #-}
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 #-}
strToIntG :: Intervals -> String -> Int
strToIntG v =
getBFst' (0, V.zip (V.fromList ["а","б","в","г","д","дж","дз","е","ж","з","и","й","к","л","м","н","о","п","р","с","т","у","ф","х","ц","ч","ш",
"і","ґ"]) v)
{-# INLINE strToIntG #-}
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
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
durationsAver :: Durations -> Double -> Durations
durationsAver = doublesAveragedA
strengthsAver :: Strengths -> Double -> Strengths
strengthsAver = doublesAveragedG
strengthsDbAver :: StrengthsDb -> Double -> StrengthsDb
strengthsDbAver = doublesAveragedG
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
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
str2Durat1 :: String -> Double
str2Durat1 = getBFst' ((-0.153016), V.fromList [("-", (-0.101995)), ("0", (-0.051020)), ("1", (-0.153016)), ("а", 0.138231), ("б", 0.057098),
("в", 0.082268), ("г", 0.076825), ("д", 0.072063), ("дж", 0.048934), ("дз", 0.055601), ("е", 0.093605), ("ж", 0.070612), ("з", 0.056054),
("и", 0.099955), ("й", 0.057143), ("к", 0.045397), ("л", 0.064036), ("м", 0.077370), ("н", 0.074240), ("о", 0.116463), ("п", 0.071837),
("р", 0.049206), ("с", 0.074603), ("сь", 0.074558), ("т", 0.110658), ("у", 0.109070), ("ф", 0.062268), ("х", 0.077188), ("ц", 0.053061),
("ць", 0.089342), ("ч", 0.057551), ("ш", 0.066077), ("ь", 0.020227), ("і", 0.094150), ("ґ", 0.062948)])
str2Volume :: String -> Strengths
str2Volume = V.map (getBFst' (0.0, V.fromList [("а", 0.890533), ("б", 0.718872), ("в", (-0.630859)), ("г", (-0.757599)), ("д", (-0.624176)),
("дж", 0.768127), ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.837921)), ("з", (-0.528870)), ("и", (-0.770935)), ("й", (-0.708008)),
("к", 0.886139), ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", (-0.212402)), ("р", 0.651062),
("с", 0.155640), ("сь", (-0.207764)), ("т", 0.304413), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)),
("ць", 0.381348), ("ч", 0.242615), ("ш", 0.251221), ("ь", 0.495483), ("і", 0.682709), ("ґ", 0.557098)])) . convertToProperUkrainian
str2Vol1 :: String -> Double
str2Vol1 = getBFst' (0.0, V.fromList [("а", 0.890533), ("б", 0.718872), ("в", (-0.630859)), ("г", (-0.757599)), ("д", (-0.624176)),
("дж", 0.768127), ("дз", (-0.731262)), ("е", (-0.742523)), ("ж", (-0.837921)), ("з", (-0.528870)), ("и", (-0.770935)), ("й", (-0.708008)),
("к", 0.886139), ("л", 0.572632), ("м", (-0.782349)), ("н", (-0.797607)), ("о", (-0.579559)), ("п", (-0.212402)), ("р", 0.651062),
("с", 0.155640), ("сь", (-0.207764)), ("т", 0.304413), ("у", 0.718262), ("ф", (-0.374359)), ("х", (-0.251160)), ("ц", (-0.392365)),
("ць", 0.381348), ("ч", 0.242615), ("ш", 0.251221), ("ь", 0.495483), ("і", 0.682709), ("ґ", 0.557098)]) . V.unsafeHead . convertToProperUkrainian
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 ""
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
apply6Gf :: Double -> FilePath -> IO ()
apply6Gf vol file = soxE file ["norm","vol", showFFloat (Just 4) vol ""]
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
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
apply6GS2 :: String -> String -> String -> Double -> IO ()
apply6GS2 xs = apply6G2 (str2Volume xs)
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
octavesT :: NotePairs
octavesT = V.generate 9 (\i -> (V.unsafeIndex notes (i * 12), V.unsafeIndex notes (i * 12 + 11)))
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
pureQuintNote :: Double -> Double
pureQuintNote x = x / 2 ** (7 / 12)
{-# INLINE pureQuintNote #-}
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))))
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))
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)
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))) ++ ">))"
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
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
sameOvertone :: OvertonesO -> Bool
sameOvertone v
| V.null v = False
| otherwise = V.all (\(x,_) -> x == (fst . V.unsafeIndex v $ 0)) v
sameOvertoneL :: [(Double,Double)] -> Bool
sameOvertoneL xs@((x,y):_) = all (\(xn,_) -> xn == x) xs
sameOvertoneL _ = False
sameFreqF :: Double -> (Double,Double) -> (Double -> OvertonesO) -> ((Double,Double) -> OvertonesO -> OvertonesO) -> OvertonesO
sameFreqF freq (noteN0,amplN0) f g = g (noteN0,amplN0) (f freq)
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
fAddFElem :: (Double, Double) -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fAddFElem (noteN, amplN) f gAdd t = gAdd (noteN, amplN) t f
fRemoveFElem :: (Double, Double) -> (Double -> OvertonesO) -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fRemoveFElem (noteN, amplN) f gRem t = gRem (noteN, amplN) t f
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
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
gAdd02 :: Double -> (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO
gAdd02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq
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
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
gRem02 :: Double -> (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO
gRem02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq
fAddFElems :: OvertonesO -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fAddFElems v f gAdds t = gAdds v t f
fRemoveFElems :: OvertonesO -> (Double -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Double -> OvertonesO)
fRemoveFElems v f gRems t = gRems v t f
fChangeFElems :: OvertonesO -> Double -> (Double -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO)) -> (Double -> OvertonesO) ->
(Double -> OvertonesO)
fChangeFElems v freq h f t = (h freq) v t f
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
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
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]
gAdds02 :: Double -> OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO
gAdds02 amplMax v0 freq = renormFD amplMax . gAdds01 v0 freq
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
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
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
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
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
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)
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)
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
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
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
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
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
overConcat :: V.Vector OvertonesO -> OvertonesO
overConcat = V.concat . V.toList