{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module DobutokO.Sound.Functional (
SoundsO
, OvertonesO
, NotePairs
, notes
, neighbourNotes
, closestNote
, pureQuintNote
, overTones
, nkyT
, whichEnka
, enkuUp
, enkuDown
, liftInEnkuV
, liftInEnku
, octavesT
, mixTest
, 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
, partialTest_k1G
, soundGenF3
, overSoXSynthGen2FDN_SG
, overSoXSynthGen2FDN_Sf3G
, soundGenF31G
, adjust_dbVol
, partialTest_k
, prependZeroes
, nOfZeroesLog
, numVZeroesPre
, syllableStr
, intervalsFromString
, vStrToVInt
, strToInt
, doubleVecFromVecOfDouble
, helpF1
, helpF0
) where
import CaseBi (getBFst')
import Data.Char (isDigit)
import System.Exit (ExitCode( ExitSuccess ))
import Numeric
import Data.List (isPrefixOf,sort,sortBy,nubBy)
import Data.Maybe (isNothing,fromJust,isJust,fromMaybe,maybe)
import qualified Data.Vector as V
import System.Process
import EndOfExe
import System.Directory
import Melodics.Ukrainian (convertToProperUkrainian)
import SoXBasics (durationA)
import MMSyn7.Syllable
type SoundsO = V.Vector (Double, Double)
type OvertonesO = V.Vector (Double, Double)
type NotePairs = V.Vector (Double, Double)
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 (Just 4) y (show 0) ++ "dB","0.01"]
overSoXSynth2FDN1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO ()
overSoXSynth2FDN1G f (x, y) j zs vdB
| V.null . convertToProperUkrainian $ zs = overSoXSynth x
| otherwise = do
let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
l0 = length zs
note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0
g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) ->
if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,
abs (amplX - (fromIntegral . truncate $ amplX)))) . f
g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) .
V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k
v0 = g note0
v1 = maybe V.empty g note1
ts = showFFloat (Just 4) (abs y) $ show 0
overSoXSynthHelp vec =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
overSoXSynthHelp2 vec vdB =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] (V.unsafeIndex vdB i)) "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then overSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
overSoXSynthHelp v0
overSoXSynthHelp2 v1 vdB
mixTest
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
freqsFromFile :: FilePath -> Int -> IO (V.Vector Int)
freqsFromFile file n = V.generateM n (\k -> do {
(_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat (Just 4) (fromIntegral k * 0.001) $ show 0,
"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 = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.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."
partialTest_k :: OvertonesO -> Int -> String -> IO ()
partialTest_k vec k ts =
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")) ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] ""
path1s <- listDirectory "."
let path2s = sort . filter (isPrefixOf $ "test" ++ show k) $ path1s
(code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-" ++ show k ++ prependZeroes zeroN
(show (i `quot` 50)) ++ ".wav"]) ""
case code of
ExitSuccess -> mapM_ removeFile path2s
_ -> do
exi <- doesFileExist $ "test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ ".wav"
if exi then putStrLn ("DobutokO.Sound.Functional.partialTest_k: " ++ herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ ".wav")
else putStrLn $ "DobutokO.Sound.Functional.partialTest_k: " ++ herr0
else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec
partialTest_k1G :: OvertonesO -> Int -> String -> V.Vector Double -> IO ()
partialTest_k1G vec k ts vdB =
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")) (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] (V.unsafeIndex vdB i)) ""
path1s <- listDirectory "."
let path2s = sort . filter (isPrefixOf $ "test" ++ show k) $ path1s
(code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-" ++ show k ++ prependZeroes zeroN
(show (i `quot` 50)) ++ ".wav"]) ""
case code of
ExitSuccess -> mapM_ removeFile path2s
_ -> do
exi <- doesFileExist $ "test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ ".wav"
if exi then putStrLn ("DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ ".wav")
else putStrLn $ "DobutokO.Sound.Functional.partialTest_k1G: " ++ herr0
else readProcessWithExitCode (fromJust (showE "sox")) (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] (V.unsafeIndex vdB i)) "" >> 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
| 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) $ show 0
overSoXSynthHelp vec =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
overSoXSynthHelp2 vec vdB =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
(adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] (V.unsafeIndex vdB i))"") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then overSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
overSoXSynthHelp v0
overSoXSynthHelp2 v1 vdB
mixTest
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
| 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) $ show 0
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then partialTest_k v0 0 ts
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
partialTest_k v0 0 ts
partialTest_k v1 1 ts
mixTest
overSoXSynth2FDN_S1G :: (Double -> OvertonesO) -> (Double, Double) -> Int -> String -> V.Vector Double -> IO ()
overSoXSynth2FDN_S1G f (x, y) j zs vdB
| V.null . convertToProperUkrainian $ zs = overSoXSynth x
| otherwise = do
let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
l0 = length zs
note1 = dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) note0
v0 = f note0
v1 = maybe V.empty f note1
ts = showFFloat (Just 4) (abs y) $ show 0
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then partialTest_k1G v0 0 ts vdB
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
partialTest_k1G v0 0 ts vdB
partialTest_k1G v1 1 ts vdB
mixTest
overSoXSynthGen2FDN_SG :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> ((Double -> OvertonesO) -> (Double, Double) -> Int -> String -> IO ()) -> IO ()
overSoXSynthGen2FDN_SG file m ku f y zs wws h = do
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws
renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
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)
overSoXSynthGen2FDN_Sf :: FilePath -> Int -> Int -> (Double -> OvertonesO) -> Double -> String -> String -> IO ()
overSoXSynthGen2FDN_Sf file m ku f y zs wws = do
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
overSoXSynth2FDN_Sf f (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j wws
renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
overSoXSynth2FDN_Sf3 :: (Double -> OvertonesO) -> (Double, Double, Double) -> Int -> String -> IO ()
overSoXSynth2FDN_Sf3 f (x, y, t0) j zs
| V.null . convertToProperUkrainian $ zs = overSoXSynth x
| otherwise = do
let l0 = length zs
soundGenF3 (V.fromList [\x -> closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0),\x -> fromMaybe (V.unsafeIndex notes 0)
(dNote (V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)))])
(V.replicate 2 x) (V.fromList [1,V.unsafeIndex (intervalsFromString zs) (abs (j `rem` l0))]) f (x, y, t0) j zs
mixTest
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 ->
String -> IO ()
soundGenF3 vf vd vi f (x, y, t0) j zs = 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)
l0 = length zs
ts = showFFloat (Just 4) (abs y) $ show 0
V.imapM_ (\i note1 -> do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth", showFFloat (Just 4) (abs y) $ show 0,
"sine", showFFloat (Just 4) (V.unsafeIndex vDz i) $ show 0] ""
partialTest_k (V.unsafeIndex vNotes i) i ts) vDz
soundGenF31G :: V.Vector (Double -> Double) -> V.Vector Double -> V.Vector Int -> (Double -> OvertonesO) -> (Double, Double, Double) -> Int ->
String -> V.Vector Double -> IO ()
soundGenF31G vf vd vi f (x, y, t0) j zs vdB = do
let vD = helpF1 vf vd vi
vDz = V.mapMaybe id vD
ilDz = V.length vDz - 1
vNotes = doubleVecFromVecOfDouble f t0 (V.map Just vDz)
l0 = length zs
ts = showFFloat (Just 4) (abs y) $ show 0
V.imapM_ (\i note1 -> do
_ <- readProcessWithExitCode (fromJust (showE "sox")) (adjust_dbVol ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth", showFFloat (Just 4)
(abs y) $ show 0, "sine", showFFloat (Just 4) (V.unsafeIndex vDz i) $ show 0] (V.unsafeIndex vdB i)) ""
partialTest_k1G (V.unsafeIndex vNotes i) i ts vdB) 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
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- freqsFromFile file n
let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
(t, ws) = splitAt 1 . syllableStr n $ zs
m0 = length ws
zeroN = numVZeroesPre vecB
v2 = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
h f (x, (V.unsafeIndex v2 (j `rem` (V.length v2))), t0) j wws
renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB
endFromResult
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 -> V.Vector Int
intervalsFromString = vStrToVInt . convertToProperUkrainian
vStrToVInt :: V.Vector String -> V.Vector Int
vStrToVInt = V.map strToInt
strToInt :: String -> Int
strToInt =
getBFst' (0, V.fromList [("а", 12), ("б", 4), ("в", 7), ("г", 3), ("д", 4), ("дж", 5), ("дз", 5), ("е", 12), ("ж", 3), ("з", 8), ("и", 12),
("й", 7), ("к", 10), ("л", 7), ("м", 7), ("н", 7), ("о", 12), ("п", 10), ("р", 7), ("с", 10), ("т", 2), ("у", 12), ("ф", 2), ("х", 2),
("ц", 11), ("ч", 11), ("ш", 1), ("і", 12), ("ґ", 9)])
{-# INLINE strToInt #-}
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 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN /
fromIntegral l) $ show 0] "") vec
overSoXSynthHelp2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN /
fromIntegral l) $ show 0] "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 $ show 0, "synth", "0.5","sine", "mix", showFFloat (Just 4) note1 $ show 0, "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))))