{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module DobutokO.Sound.Functional (
Params (..)
, SoundsO
, OvertonesO
, NotePairs
, Durations
, Strengths
, StrengthsDb
, Intervals
, notes
, neighbourNotes
, closestNote
, pureQuintNote
, overTones
, nkyT
, whichOctave
, whichOctaveG
, 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_SG4G
, 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
, overSoXSynthGen2FDN_SG6GSu
, dBOmegaRatio
, strength2dB_Abs
, strengthdB2ampl
, strengths2dB
, strengthsDb2ampl
, filterInParams
, sortNoDup
, toneD
, toneE
, liftInParams
, liftInParamsV
, lengthP
, elemP
, elemCloseP
, showD
, overSoXSynthGen2FDN_SG4GPar
, overSoXSynthGen2FDN_SG6GPar
, overSoXSynthGen2FDN_SG2GPar
, overSoXSynthGen2FDN_SfPar
, overSoXSynthGen2FDN_Sf3GPar
, overSoXSynthGen2FDN_Sf3G2GPar
, testSoundGen2G
, soundGen3G
, soundGen3G_O
, soundGen3G_O2
, soundGen3G_O2G
, testSoundGen2GMN
, soundGen3GMN
, soundGen3G_OMN
, soundGen3G_O2MN
, soundGen3G_O2GMN
, h1
, h2
, soundGen3G_OPar
, soundGen3G_O2Par
, soundGen3G_O2GPar
, soundGen3G_OMNPar
, soundGen3G_O2MNPar
, soundGen3G_O2GMNPar
, h2Params
, overMeloPar
) where
import Text.Read (readMaybe)
import CaseBi (getBFst')
import Data.Char (isDigit,isAsciiLower)
import System.Exit (ExitCode( ExitSuccess ))
import Numeric
import Data.List (isPrefixOf,sort,sortBy,nubBy)
import Data.Maybe (isNothing,fromJust,isJust,fromMaybe,maybe)
import qualified Data.Vector as V
import System.Process
import EndOfExe
import System.Directory
import Melodics.Ukrainian (convertToProperUkrainian)
import SoXBasics (durationA,upperBnd,selMaxAbs)
import MMSyn7.Syllable
import DobutokO.Sound.IntermediateF
import GHC.Int (Int64)
import DobutokO.Sound.Keyboard
data Params = P2 Int Int | P2s Int Int String | P3sf Int Int Int String | P4lsf Int Int Int [Int] String | P32sf Int Int Int String String
| P3lf Int Int [Int] deriving (Eq, Ord, Show)
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"]
dBOmegaRatio :: Double -> Double -> Double
dBOmegaRatio dB omega0 = omega0 * 10 ** (dB / fromIntegral 20)
strength2dB_Abs :: Double -> Double
strength2dB_Abs vol = 20 * logBase 10 (abs vol)
strengthdB2ampl :: Double -> Double
strengthdB2ampl dB = 10 ** (dB / fromIntegral 20)
strengths2dB :: Strengths -> StrengthsDb
strengths2dB v = V.map strength2dB_Abs v
strengthsDb2ampl :: StrengthsDb -> Strengths
strengthsDb2ampl v = V.map strengthdB2ampl v
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
overSoXSynthGen2FDN_SG4GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Durations -> String ->
((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO ()
overSoXSynthGen2FDN_SG4GPar file params f y v2 wws h = do
n <- duration1000 file
vecA <- freqsFromFile file n
let vecB = liftInParamsV params . V.map fromIntegral $ vecA
zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do
h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws
renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
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_SG6GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Durations -> String ->
((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Strengths -> Double -> IO ()
overSoXSynthGen2FDN_SG6GPar file params f y v2 wws h v6 limV
| V.null v6 = putStrLn "You did not provide a volume adjustments vector! "
| otherwise = do
n <- duration1000 file
vecA <- freqsFromFile file n
let vecB = liftInParamsV params . V.map fromIntegral $ vecA
zeroN = numVZeroesPre vecB in V.imapM_ (\j x -> do
h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws
renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav"
apply6GSilentFile ("result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") limV (V.unsafeIndex v6 (j `rem` V.length v6))) vecB
endFromResult
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)
overSoXSynthGen2FDN_SG6GSu :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String ->
((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> Double -> IO ()
overSoXSynthGen2FDN_SG6GSu file m ku f y zs wws h = overSoXSynthGen2FDN_SG6G file m ku f y (str2Durations zs y) wws h (str2Volume zs)
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_SG2GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) ->
(Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO ()
overSoXSynthGen2FDN_SG2GPar file params f y zs wws h ys = do
n <- duration1000 file
vecA <- freqsFromFile file n
let vecB = liftInParamsV params . V.map fromIntegral $ vecA
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do
h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws ys
renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++
if drop 3 ys == "f" then ".flac" else ".wav") vecB
endFromResult2G ys
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
overSoXSynthGen2FDN_SfPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> String -> String -> IO ()
overSoXSynthGen2FDN_SfPar file params f y zs wws = do
n <- duration1000 file
vecA <- freqsFromFile file n
let vecB = liftInParamsV params . V.map fromIntegral $ vecA
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do
overSoXSynth2FDN_Sf f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws
renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
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_Sf3GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Double -> String -> String ->
((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO ()) -> IO ()
overSoXSynthGen2FDN_Sf3GPar file params f y t0 zs wws h = do
n <- duration1000 file
vecA <- freqsFromFile file n
let vecB = liftInParamsV params . V.map fromIntegral $ vecA
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do
h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws
renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
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
overSoXSynthGen2FDN_Sf3G2GPar :: FilePath -> Params -> (Double -> OvertonesO) -> Double -> Double -> String -> String ->
((Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> String -> IO ()) -> String -> IO ()
overSoXSynthGen2FDN_Sf3G2GPar file params f y t0 zs wws h ys = do
n <- duration1000 file
vecA <- freqsFromFile file n
let vecB = liftInParamsV params . V.map fromIntegral $ vecA
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j x -> do
h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws ys
renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f"
then ".flac" else ".wav") vecB
endFromResult2G ys
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
whichOctave :: Double -> Maybe Int
whichOctave x
| compare (closestNote x) 24.4996 == GT = (\t ->
case isJust t of
True -> fmap (\z ->
case z of
0 -> z
_ -> z - 1) t
_ -> Just 8) . V.findIndex (\(t1, t2) -> compare (closestNote x) t1 == LT) $ octavesT
| otherwise = Nothing
whichOctaveG :: Double -> Maybe Int
whichOctaveG x
| compare (closestNote x) (V.unsafeIndex notes 0) == GT && compare x (V.unsafeIndex notes 107) /= GT = (\t ->
case isJust t of
True -> fmap (\z ->
case z of
0 -> z
_ -> z - 1) t
_ -> Just 8) . V.findIndex (\(t1, t2) -> compare (closestNote x) t1 == LT) $ octavesT
| otherwise = Nothing
filterInParams :: Params -> Maybe (V.Vector Double)
filterInParams (P3lf n2 nL zs)
| all (\n -> compare n 0 /= LT) ([nL,107 - nL - n2,n2 - 2] ++ zs) =
if V.null . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) i) $
(V.unsafeSlice nL n2 notes)
then Nothing
else Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) i)
(V.unsafeSlice nL n2 notes))
| otherwise = Nothing
filterInParams (P32sf nT n2 nL xs ys)
| all (\n -> compare n 0 /= LT) [107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 12] =
case xs of
"dur" -> getBFst' (Nothing,V.fromList . zip ["DoubleH","H","Full","Full moll","M","N"] $ fmap Just
[V.ifilter (\i _ -> toneD i nL nT [2,3,6,8,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,3,5,9,10])
(V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,3,5])
(V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6])
(V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,3,5,9,11]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneD i nL nT [1,3,5,8,10]) (V.unsafeSlice nL n2 notes)]) ys
"moll" -> getBFst' (Nothing,V.fromList . zip ["DoubleH1","H","Full","Full dur","M","N"] $ fmap Just
[V.ifilter (\i _ -> toneD i nL nT [1,4,5,9,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,4,6,9,10])
(V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,4,6])
(V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6])
(V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneD i nL nT [1,4,6,8,10]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneD i nL nT [1,4,6,9,11]) (V.unsafeSlice nL n2 notes)]) ys
_ -> Nothing
| otherwise = Nothing
filterInParams (P4lsf nT n2 nL zs xs)
| all (\n -> compare n 0 /= LT) ([107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 2] ++ zs) =
case xs of
"ditonic" ->
if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) $ (V.unsafeSlice nL n2 notes)) /= 2
then Nothing
else
if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 2 . sortNoDup . filter (< n2) $ zs) $
replicate n2 True) i) (V.unsafeSlice nL n2 notes))
then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 2 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) (V.unsafeSlice nL n2 notes))
else Nothing
"tritonic" ->
if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) $ (V.unsafeSlice nL n2 notes)) /= 3
then Nothing
else
if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 3 . sortNoDup . filter (< n2) $ zs) $
replicate n2 True) i) (V.unsafeSlice nL n2 notes))
then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 3 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) (V.unsafeSlice nL n2 notes))
else Nothing
"tetratonic" ->
if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) $ (V.unsafeSlice nL n2 notes)) /= 4
then Nothing
else
if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 4 . sortNoDup . filter (< n2) $ zs) $
replicate n2 True) i) (V.unsafeSlice nL n2 notes))
then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 4 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) (V.unsafeSlice nL n2 notes))
else Nothing
"octatonic" ->
if (V.length . V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) $ (V.unsafeSlice nL n2 notes)) /= 8
then Nothing
else
if (V.unsafeIndex notes nT) `V.elem` (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 8 . sortNoDup . filter (< n2) $ zs) $
replicate n2 True) i) (V.unsafeSlice nL n2 notes))
then Just (V.ifilter (\i _ -> getBFst' (False,V.fromList . zip (take 8 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True)
i) (V.unsafeSlice nL n2 notes))
else Nothing
_ -> Nothing
| compare nL 0 /= LT && compare nL 107 /= GT && n2 == 1 && xs == "monotonic" = Just (V.singleton (V.unsafeIndex notes nL))
| otherwise = Nothing
filterInParams (P2 nL n2)
| all (\n -> compare n 0 /= LT) [107 - nL - n2,nL,n2 - 2] = Just (V.unsafeSlice nL n2 notes)
| otherwise = Nothing
filterInParams (P2s nL n2 xs)
| all (\n -> compare n 0 /= LT) [107 - nL - n2,nL,n2 - 12] =
getBFst' (Nothing,V.fromList . zip ["Egyptian pentatonic", "Prometheus hexatonic scale", "Ukrainian Dorian scale", "augmented hexatonic scale",
"blues major pentatonic", "blues minor pentatonic", "blues scale", "major hexatonic scale", "major pentatonic", "minor hexatonic scale",
"minor pentatonic", "tritone hexatonic scale", "two-semitone tritone hexatonic scale", "whole tone scale"] $ map Just
[V.ifilter (\i _ -> toneE i nL nL [0,2,5,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,2,4,6,9,10]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneE i nL nL [0,2,3,6,7,9,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,4,7,8,11]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneE i nL nL [0,2,5,7,9]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,8,10]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneE i nL nL [0,3,5,6,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,6,7,10]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneE i nL nL [0,2,4,5,7,9]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,2,4,7,9]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneE i nL nL [0,2,3,5,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,3,5,7,10]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneE i nL nL [0,1,4,6,7,10]) (V.unsafeSlice nL n2 notes), V.ifilter (\i _ -> toneE i nL nL [0,1,3,7,8,9]) (V.unsafeSlice nL n2 notes),
V.ifilter (\i _ -> toneE i nL nL [0,2,4,6,8,10]) (V.unsafeSlice nL n2 notes)]) xs
| otherwise = Nothing
filterInParams (P3sf nT nL n2 xs)
| all (\n -> compare n 0 /= LT) [101 - nL,nT,nL,nT - nL,nL + 6 - nT] && n2 == 6 =
case xs of
"Dorian tetrachord" ->
if (nT - nL) `elem` [0,1,3,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,1,3,5]) (V.unsafeSlice nL 6 notes)) else Nothing
"Phrygian tetrachord" ->
if (nT - nL) `elem` [0,2,3,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,2,3,5]) (V.unsafeSlice nL 6 notes)) else Nothing
"Lydian tetrachord" ->
if (nT - nL) `elem` [0,2,4,5] then Just (V.ifilter (\i _ -> toneE i nL nT [0,2,4,5]) (V.unsafeSlice nL 6 notes)) else Nothing
_ -> Nothing
| all (\n -> compare n 0 /= LT) [94 - nL,nT,nL,nT - nL,nL + 13 - nT] && n2 == 13 =
getBFst' (Nothing, V.fromList . zip ["modern Aeolian mode", "modern Dorian mode", "modern Ionian mode", "modern Locrian mode",
"modern Lydian mode", "modern Mixolydian mode", "modern Phrygian mode"] $ fmap (h3 nT n2 nL) [[1,4,6,9,11], [1,4,6,8,11], [1,3,6,8,10],
[2,4,7,9,11], [1,3,5,8,10], [1,3,6,8,11], [2,4,6,9,11]]) xs
| otherwise = Nothing
h3 :: Int -> Int -> Int -> [Int] -> Maybe (V.Vector Double)
h3 nT n2 nL zs
| nT == nL = Just (V.ifilter (\i _ -> toneD i nL nT zs) (V.unsafeSlice nL n2 notes))
| otherwise = Nothing
sortNoDup :: Ord a => [a] -> [a]
sortNoDup = sortNoDup' . sort
where sortNoDup' (x:x1@(y:_))
| x == y = sortNoDup' x1
| otherwise = x:sortNoDup' x1
sortNoDup' (x:_) = [x]
sortNoDup' _ = []
toneD :: Int -> Int -> Int -> [Int] -> Bool
toneD i nL nT zs = getBFst' (True,V.fromList . zip zs $ replicate 12 False) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12)
toneE :: Int -> Int -> Int -> [Int] -> Bool
toneE i nL nT zs = getBFst' (False,V.fromList . zip zs $ replicate 12 True) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12)
liftInParams :: Double -> Params -> Double
liftInParams x params
| lengthP params == 0 || (isNothing . whichOctaveG $ x) = 11440.0
| otherwise =
V.unsafeIndex (fromJust . filterInParams $ params) (V.minIndex . V.map (abs . log . (\t -> t / x)) . V.generate (lengthP params) $
(\i -> V.unsafeIndex notes (12 * fromJust (whichOctaveG x)) * 2 ** (fromIntegral i / fromIntegral (lengthP params))))
liftInParamsV :: Params -> V.Vector Double -> V.Vector Double
liftInParamsV params = V.filter (/= 11440.0) . V.map (\x -> liftInParams x params)
lengthP :: Params -> Int
lengthP = fromMaybe 0 . fmap V.length . filterInParams
elemP :: Double -> Params -> Bool
elemP note = fromMaybe False . fmap (note `V.elem`) . filterInParams
elemCloseP :: Double -> Params -> Bool
elemCloseP note = fromMaybe False . fmap (closestNote note `V.elem`) . filterInParams
showD :: Params -> String
showD = show . filterInParams
testSoundGen2G :: FilePath -> (Double -> OvertonesO) -> Double -> String -> IO ()
testSoundGen2G = testSoundGen2GMN (-1) (-1)
testSoundGen2GMN :: Int64 -> Int64 -> FilePath -> (Double -> OvertonesO) -> Double -> String -> IO ()
testSoundGen2GMN m n1 file f y zs = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m n1) file)
let n = V.length vecA0
freq0 j = V.unsafeIndex notes (snd . V.unsafeIndex vecA0 $ j `rem` n)
f0 t = V.fromList [(0.05763181818181818 * t, 0.3598),(1.112159090909091 * t, 0.4588962),(2 * t, 0.6853),(3 * t, 0.268),(4 * t, 0.6823),(5 * t, 0.53)]
fA1 j = fAddFElem (freq0 (j + 1),0.5) f0 gAdd04
fR1 j = fRemoveFElem (freq0 (j + 1),0.5) f0 gRem03
vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r),
case fst r of
0 -> f0
1 -> fA1 j
2 -> fA1 j
3 -> fA1 j
4 -> fA1 j
_ -> fR1 j)) vecA0
v2 = str2DurationsDef n zs y
zeroN = numVZeroesPre vecB in V.imapM_ (\j (x,k) -> do
h1 (\u -> k (1.1 * freq0 j)) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
soundGen3G :: FilePath -> (Double -> OvertonesO) -> Double -> String -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO)
-> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G = soundGen3GMN (-1) (-1)
soundGen3GMN :: Int64 -> Int64 -> FilePath -> (Double -> OvertonesO) -> Double -> String -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO)
-> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3GMN m n1 file f y zs gAdd gRem f0 = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m n1) file)
let n = V.length vecA0
freq0 j = V.unsafeIndex notes (snd . V.unsafeIndex vecA0 $ j `rem` n)
fA1 j = fAddFElem (freq0 (j + 1),0.5) f0 gAdd
fR1 j = fRemoveFElem (freq0 (j + 1),0.5) f0 gRem
vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r),
case fst r of
0 -> f0
1 -> fA1 j
2 -> fA1 j
3 -> fA1 j
4 -> fA1 j
_ -> fR1 j)) vecA0
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do
h1 (\u -> k (1.1 * freq0 j)) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
soundGen3G_O :: Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO)
-> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) ->
(Double -> OvertonesO) -> IO ()
soundGen3G_O = soundGen3G_OMN (-1) (-1)
soundGen3G_OPar :: Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO)
-> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) ->
(Double -> OvertonesO) -> IO ()
soundGen3G_OPar = soundGen3G_OMNPar (-1) (-1)
soundGen3G_OMN :: Int64 -> Int64 -> Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO)
-> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) ->
(Double -> OvertonesO) -> IO ()
soundGen3G_OMN m1 n1 m ku freq1 file f y zs gAdds gRems freq0 proj f0 = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file)
let n = V.length vecA0
fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds
fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems
vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r),
case fst r of
0 -> f0
1 -> fA1 j
2 -> fA1 j
3 -> fA1 j
4 -> fA1 j
_ -> fR1 j)) vecA0
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do
h2 (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) m ku freq1
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
soundGen3G_OMNPar :: Int64 -> Int64 -> Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO)
-> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Int -> OvertonesO) -> (OvertonesO -> OvertonesO) ->
(Double -> OvertonesO) -> IO ()
soundGen3G_OMNPar m1 n1 params freq1 file f y zs gAdds gRems freq0 proj f0 = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file)
let n = V.length vecA0
fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds
fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems
vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r),
case fst r of
0 -> f0
1 -> fA1 j
2 -> fA1 j
3 -> fA1 j
4 -> fA1 j
_ -> fR1 j)) vecA0
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do
h2Params (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) params freq1
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
soundGen3G_O2 :: ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2 = soundGen3G_O2MN (-1) (-1)
soundGen3G_O2Par :: ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2Par = soundGen3G_O2MNPar (-1) (-1)
soundGen3G_O2MN :: Int64 -> Int64 -> ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2MN m1 n1 conversionFII m ku freq1 file f y zs gAdds gRems freq0 proj f0 = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file)
let n = V.length vecA0
fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds
fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems
vecB = conversionFII (f0,fA1,fR1) vecA0
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do
h2 (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) m ku freq1
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
soundGen3G_O2MNPar :: Int64 -> Int64 -> ((Double -> OvertonesO,Int -> Double -> OvertonesO,Int -> Double -> OvertonesO) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (OvertonesO -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2MNPar m1 n1 conversionFII params freq1 file f y zs gAdds gRems freq0 proj f0 = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file)
let n = V.length vecA0
fA1 j = fAddFElems (proj . freq0 $ j) f0 gAdds
fR1 j = fRemoveFElems (proj . freq0 $ j) f0 gRems
vecB = conversionFII (f0,fA1,fR1) vecA0
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do
h2Params (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) params freq1
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
soundGen3G_O2G :: ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) ->
Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2G = soundGen3G_O2GMN (-1) (-1)
soundGen3G_O2GPar :: ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) ->
Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2GPar = soundGen3G_O2GMNPar (-1) (-1)
soundGen3G_O2GMN :: Int64 -> Int64 -> ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) ->
Int -> Int -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2GMN m1 n1 conversionFII vf vfA vfR m ku freq1 file f y zs gAdds gRems freq0 f0 = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file)
let n = V.length vecA0
vecB = conversionFII (vf,vfA,vfR) vecA0
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do
h2 (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) m ku freq1
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
soundGen3G_O2GMNPar :: Int64 -> Int64 -> ((V.Vector (Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO),V.Vector (Int -> Double -> OvertonesO)) -> V.Vector (Int,Int) ->
V.Vector (Double,Double -> OvertonesO)) -> V.Vector (Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) -> V.Vector (Int -> Double -> OvertonesO) ->
Params -> Double -> FilePath -> (Double -> OvertonesO) -> Double -> String ->
(OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO) ->
(Int -> OvertonesO) -> (Double -> OvertonesO) -> IO ()
soundGen3G_O2GMNPar m1 n1 conversionFII vf vfA vfR params freq1 file f y zs gAdds gRems freq0 f0 = do
vecA0 <- fmap (V.map (`quotRem` 108)) ((if m1 == (-1) && n1 == (-1) then readFileDoubles else readFileDoublesMN m1 n1) file)
let n = V.length vecA0
vecB = conversionFII (vf,vfA,vfR) vecA0
zeroN = numVZeroesPre vecB
v2 = str2DurationsDef n zs y in V.imapM_ (\j (x,k) -> do
h2Params (k x) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) params freq1
renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
h1 :: (Double -> OvertonesO) -> (Double, Double) -> Int -> IO ()
h1 f (x, y) j = do
let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
v0 = f note0
ts = showFFloat (Just 4) (abs y) ""
case compare y 0.0 of
GT -> do
(_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] ""
print herr
partialTest_k v0 0 ts
mixTest
LT -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing note0 "","vol","0"] "" >>=
\(_,_,herr) -> putStr herr
_ -> putStrLn "Zero length of the sound! "
h2 :: OvertonesO -> (Double, Double) -> Int -> Int -> Double -> IO ()
h2 v (x, y) m ku freq1 = do
let note0 = fromMaybe freq1 . liftInEnku m ku . closestNote $ (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
ts = showFFloat (Just 4) (abs y) ""
case compare y 0.0 of
GT -> do
(_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] ""
print herr
partialTest_k v 0 ts
mixTest
LT -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing note0 "","vol","0"] "" >>=
\(_,_,herr) -> putStr herr
_ -> putStrLn "Zero length of the sound! "
h2Params :: OvertonesO -> (Double, Double) -> Params -> Double -> IO ()
h2Params v (x, y) params freq1 = do
let note01 = flip liftInParams params (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
ts = showFFloat (Just 4) (abs y) ""
note0 = if note01 == 11440.0 then freq1 else note01
case compare y 0.0 of
GT -> do
(_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] ""
print herr
partialTest_k v 0 ts
mixTest
LT -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing note0 "","vol","0"] "" >>=
\(_,_,herr) -> putStr herr
_ -> putStrLn "Zero length of the sound! "
overMeloPar :: (Double -> OvertonesO) -> (Double -> Double) -> Params -> Double -> Double -> Double -> IO ()
overMeloPar f g params coeff freq0 freq = do
let v = f freq
vFreqs = V.map ((\z -> if z == 11440.0 then freq0 else z) . flip liftInParams params . fst) v
vD = V.map (g . (* coeff) . snd) v
v2 = V.map f vFreqs
vS = V.map (\z -> showFFloat (Just 4) (abs z) "") vD
h42 j (x,v3,y,ts)
| compare y 0.0 == GT = do
(_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing (fst x) ""] ""
print herr
partialTest_k v3 0 ts
mixTest
renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav"
| compare y 0.0 == LT = do
(_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"] ""
putStr herr
renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav"
| otherwise = putStrLn "Zero length of the sound! "
V.imapM_ (\j zz -> h42 j zz) . V.zip4 v v2 vD $ vS