{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module DobutokO.Sound (
oberSoXSynthN
, oberTones2
, oberSoXSynth2
, oberSoXSynthN2
, oberSoXSynthN3
, oberSoXSynthDN
, oberSoXSynth2DN
, oberSoXSynthNGen
, oberSoXSynthNGen2
, oberSoXSynthNGen3
, uniqOberTonesV
, uniqOberSoXSynth
, uniqOberSoXSynthN
, uniqOberTonesV2
, uniqOberSoXSynth2
, uniqOberSoXSynthN3
, uniqOberSoXSynthN4
, uniqOberSoXSynthNGen
, uniqOberSoXSynthNGen3
, uniqOberSoXSynthNGen4
, octaveUp
, octaveDown
, whichOctave
, liftInOctave
, liftInOctaveV
, dviykyTA
, triykyTA
, chetvirkyTA
, p'yatirkyTA
, shistkyTA
, simkyTA
, visimkyTA
, dev'yatkyTA
, desyatkyTA
, odynadtsyatkyTA
, octavesTA
, oberSoXSynthNGenE
, oberSoXSynthNGen2E
, oberSoXSynthNGen3E
, uniqOberSoXSynthNGenE
, uniqOberSoXSynthNGen3E
, uniqOberSoXSynthNGen4E
, signsFromString
) where
import CaseBi (getBFst')
import System.Exit (ExitCode(ExitSuccess))
import Numeric (showFFloat)
import Control.Exception (onException)
import System.Environment (getArgs)
import Data.List (isPrefixOf,sort,sortBy,nubBy)
import Data.Maybe (isJust,isNothing,fromJust)
import Data.Char (isDigit)
import qualified Data.Vector as V
import System.Process
import EndOfExe (showE)
import MMSyn7.Syllable
import MMSyn7s
import System.Directory
import SoXBasics
import Processing_mmsyn7ukr
import Melodics.Ukrainian (convertToProperUkrainian)
import DobutokO.Sound.Functional
dviykyTA :: NotePairs
dviykyTA = V.generate 107 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 1)))
triykyTA :: NotePairs
triykyTA = V.generate 106 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 2)))
chetvirkyTA :: NotePairs
chetvirkyTA = V.generate 105 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 3)))
p'yatirkyTA :: NotePairs
p'yatirkyTA = V.generate 104 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 4)))
shistkyTA :: NotePairs
shistkyTA = V.generate 103 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 5)))
simkyTA :: NotePairs
simkyTA = V.generate 102 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 6)))
visimkyTA :: NotePairs
visimkyTA = V.generate 101 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 7)))
dev'yatkyTA :: NotePairs
dev'yatkyTA = V.generate 100 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 8)))
desyatkyTA :: NotePairs
desyatkyTA = V.generate 99 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 9)))
odynadtsyatkyTA :: NotePairs
odynadtsyatkyTA = V.generate 98 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 10)))
octavesTA :: NotePairs
octavesTA = V.generate 97 (\i -> (V.unsafeIndex notes i, V.unsafeIndex notes (i + 11)))
octaveUp :: Double -> Double
octaveUp x = 2 * x
{-# INLINE octaveUp #-}
octaveDown :: Double -> Double
octaveDown x = x / fromIntegral 2
{-# INLINE octaveDown #-}
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
liftInOctave :: Int -> Double -> Maybe Double
liftInOctave n x
| compare n 0 == LT || compare n 8 == GT = Nothing
| compare (closestNote x) 24.4996 == GT =
case compare (fromJust . whichOctave $ x) n of
EQ -> Just (closestNote x)
LT -> let z = log (V.unsafeIndex notes (n * 12) / closestNote x) / log 2.0
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) octaveUp $ closestNote x)
else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 2) octaveUp $ closestNote x)
_ -> let z = log (closestNote x / V.unsafeIndex notes (n * 12)) / log 2.0
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) octaveDown $ closestNote x)
else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 1) octaveDown $ closestNote x)
| otherwise = Nothing
liftInOctaveV :: Int -> V.Vector Double -> V.Vector Double
liftInOctaveV n = V.mapMaybe (\z -> liftInOctave n z)
uniqOberTonesV :: Double -> String -> ObertonesO
uniqOberTonesV note xs =
let ys = uniquenessPeriods xs
z = sum ys
v = V.fromList . fmap (\y -> fromIntegral y / fromIntegral z) $ ys
z2 = V.length v
v2 = V.generate z2 $ (\i -> V.unsafeIndex v i / fromIntegral (i + 1)) in
V.takeWhile (\(!u,!z) -> compare u (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.unsafeSlice 1 (z2 - 1) .
V.zip (V.generate z2 (\i -> note * fromIntegral (i + 1))) $ v2
signsFromString :: Int -> String -> V.Vector Int
signsFromString n1 ts =
V.take n1 . V.fromList . concatMap (fmap (\x ->
case x of
Vowel _ -> 1
Voiced _ -> 1
VoicedP _ -> 1
Voiceless _ -> (-1)
VoicelessP _ -> (-1)
Sonorous _ -> (-1)
SonorousP _ -> (-1)
_ -> 0) . concat . fmap representProlonged) . syllablesUkrP . take (3 * n1) . cycle $ ts
oberTones2 :: Double -> String -> ObertonesO
oberTones2 note ts =
V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.filter (\(_, t4) -> t4 /= 0.0) .
V.zip (V.generate 1024 (\i -> note * fromIntegral (i + 2))) $ (V.generate 1024 (\i -> fromIntegral (V.unsafeIndex (signsFromString 1024 ts)
(i + 1)) / fromIntegral ((i + 1) * (i + 1))))
uniqOberTonesV2 :: Double -> String -> String -> ObertonesO
uniqOberTonesV2 note xs ts =
let ys = uniquenessPeriods xs
z = sum ys
v = V.fromList . fmap (\y -> fromIntegral y / fromIntegral z) $ ys
z2 = V.length v
v2 = V.generate z2 $ (\i -> (V.unsafeIndex (V.map fromIntegral . signsFromString z2 $ ts) i) * V.unsafeIndex v i / fromIntegral (i + 1)) in
V.takeWhile (\(!u,!z) -> compare u (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) . V.filter (\(_, t4) -> t4 /= 0.0) .
V.unsafeSlice 1 (z2 - 1) . V.zip (V.generate z2 (\i -> note * fromIntegral (i + 1))) $ v2
oberSoXSynthDN :: Double -> String -> IO ()
oberSoXSynthDN x zs
| V.null . convertToProperUkrainian $ zs = oberSoXSynth x
| otherwise = do
let note0 = closestNote x
note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
v0 = oberTones note0
v1 = if isNothing note1 then V.empty
else oberTones . fromJust $ note1
oberSoXSynthHelp 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
oberSoXSynthHelp2 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", "testA.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 $ show 0, "vol","0.5"] ""
if isNothing note1 then do oberSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", "0.5","sine", showFFloat (Just 4) (fromJust note1) $ show 0, "vol","0.5"] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
mixTest
oberSoXSynth2DN :: Double -> Double -> String -> IO ()
oberSoXSynth2DN x y zs
| V.null . convertToProperUkrainian $ zs = oberSoXSynth x
| otherwise = do
let note0 = closestNote x
note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
v0 = oberTones note0
v1 = if isNothing note1 then V.empty
else oberTones . fromJust $ note1
oberSoXSynthHelp vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
oberSoXSynthHelp2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0, "vol","0.5"] ""
if isNothing note1 then do oberSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0, "vol","0.5"] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
mixTest
oberSoXSynth2 :: Double -> String -> IO ()
oberSoXSynth2 x tts = do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = oberTones2 note0 tts
v1 = oberTones2 note1 tts
oberSoXSynthHelp 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
oberSoXSynthHelp2 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"] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
mixTest
oberSoXSynthN :: Int -> Double -> Double -> String -> V.Vector Double -> IO ()
oberSoXSynthN n ampL time3 zs vec0
| compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT =
let (t, ws) = splitAt 1 . syllableStr n $ zs
m = length ws
zeroN = numVZeroesPre vec0
v2 = V.map (\yy -> time3 * fromIntegral (yy * m) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = oberTones note0
v1 = oberTones note1
oberSoXSynthHelpN vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine",
showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
oberSoXSynthHelpN2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav",
"synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note01 $ show 0, "synth", showFFloat (Just 4)
(V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", "mix", showFFloat (Just 4) note02 $ show 0, "vol","0.5"] ""
soxSynthHelpMain note0 note1
oberSoXSynthHelpN v0
oberSoXSynthHelpN2 v1
mixTest) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if abs ampL1 < 0.01 then oberSoXSynthN n 0.01 time3 zs vec0
else oberSoXSynthN n ampL1 time3 zs vec0
oberSoXSynthN2 :: Int -> Double -> Double -> String -> String -> V.Vector Double -> IO ()
oberSoXSynthN2 n ampL time3 zs tts vec0
| compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT =
let (t, ws) = splitAt 1 . syllableStr n $ zs
m = length ws
zeroN = numVZeroesPre vec0
v2 = V.map (\yy -> time3 * fromIntegral (yy * m) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = oberTones2 note0 tts
v1 = oberTones2 note1 tts
oberSoXSynthHelpN vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine",
showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
oberSoXSynthHelpN2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav",
"synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note01 $ show 0, "synth", showFFloat (Just 4)
(V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", "mix", showFFloat (Just 4) note02 $ show 0, "vol","0.5"] ""
soxSynthHelpMain note0 note1
oberSoXSynthHelpN v0
oberSoXSynthHelpN2 v1
mixTest) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if abs ampL1 < 0.01 then oberSoXSynthN2 n 0.01 time3 zs tts vec0
else oberSoXSynthN2 n ampL1 time3 zs tts vec0
oberSoXSynthN3 :: Int -> Double -> Double -> Double -> String -> String -> String -> V.Vector Double -> IO ()
oberSoXSynthN3 n ampL time3 dAmpl zs tts vs vec0
| compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT =
let (t, ws) = splitAt 1 . syllableStr n $ zs
m = length ws
zeroN = numVZeroesPre vec0
v3 = intervalsFromString vs
l = length vs
v2 = V.map (\yy -> time3 * fromIntegral (yy * m) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
let note0 = closestNote x
note1 = dNote (V.unsafeIndex v3 (j `rem` l)) note0
v0 = oberTones2 note0 tts
v1 = if isNothing note1 then V.empty
else oberTones2 (fromJust note1) tts
oberSoXSynthHelpN vec = let l1 = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine",
showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l1 * ampL) $ show 0] "") vec
oberSoXSynthHelpN2 vec = let l1 = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (if dAmpl * amplN / fromIntegral l1 * ampL > 1.0 then 1.0 else dAmpl
* amplN / fromIntegral l1 * ampL) $ show 0] "") vec
soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++ ".wav",
"synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note01 $ show 0, "vol","0.5"] ""
soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" ++
prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note02 $
show 0, "vol", showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / fromIntegral 2) $ show 0] ""
if isNothing note1 then do { soxSynthHelpMain0 note0
; oberSoXSynthHelpN v0 }
else do { soxSynthHelpMain0 note0
; soxSynthHelpMain1 (fromJust note1)
; oberSoXSynthHelpN v0
; oberSoXSynthHelpN2 v1}
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result0" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) ""
mapM_ removeFile paths) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if abs ampL1 < 0.01 then oberSoXSynthN3 n 0.01 time3 dAmpl zs tts vs vec0
else oberSoXSynthN3 n ampL1 time3 dAmpl zs tts vs vec0
oberSoXSynthNGen :: FilePath -> Int -> Double -> Double -> String -> IO ()
oberSoXSynthNGen file m ampL time3 zs = oberSoXSynthNGenE file m 12 ampL time3 zs
oberSoXSynthNGenE :: FilePath -> Int -> Int -> Double -> Double -> String -> IO ()
oberSoXSynthNGenE file m ku ampL time3 zs = 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
oberSoXSynthN n ampL time3 zs vecB
endFromResult
oberSoXSynthNGen2 :: FilePath -> Int -> Double -> Double -> String -> String -> IO ()
oberSoXSynthNGen2 file m ampL time3 zs tts = oberSoXSynthNGen2E file m 12 ampL time3 zs tts
oberSoXSynthNGen2E :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> IO ()
oberSoXSynthNGen2E file m ku ampL time3 zs tts = 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
oberSoXSynthN2 n ampL time3 zs tts vecB
endFromResult
oberSoXSynthNGen3 :: FilePath -> Int -> Double -> Double -> Double -> String -> String -> String -> IO ()
oberSoXSynthNGen3 file m ampL time3 dAmpl zs tts vs = oberSoXSynthNGen3E file m 12 ampL time3 dAmpl zs tts vs
oberSoXSynthNGen3E :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> IO ()
oberSoXSynthNGen3E file m ku ampL time3 dAmpl zs tts vs = 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
oberSoXSynthN3 n ampL time3 dAmpl zs tts vs vecB
endFromResult
uniqOberSoXSynth :: Double -> String -> IO ()
uniqOberSoXSynth x wws = do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = uniqOberTonesV note0 wws
v1 = uniqOberTonesV note1 wws
uniqOberSoXSynthHelp 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
uniqOberSoXSynthHelp2 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", "test-.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"] ""
uniqOberSoXSynthHelp v0
uniqOberSoXSynthHelp2 v1
mixTest
uniqOberSoXSynth2 :: Double -> String -> String -> IO ()
uniqOberSoXSynth2 x wws tts = do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = uniqOberTonesV2 note0 wws tts
v1 = uniqOberTonesV2 note1 wws tts
uniqOberSoXSynthHelp 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
uniqOberSoXSynthHelp2 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", "test-.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"] ""
uniqOberSoXSynthHelp v0
uniqOberSoXSynthHelp2 v1
mixTest
uniqOberSoXSynthN :: Int -> Double -> Double -> String -> String -> V.Vector Double -> IO ()
uniqOberSoXSynthN n ampL time3 zs wws vec0
| compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT =
let (t, ws) = splitAt 1 . syllableStr n $ zs
m = length ws
zeroN = numVZeroesPre vec0
v2 = V.map (\yy -> time3 * fromIntegral (yy * m) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = uniqOberTonesV note0 wws
v1 = uniqOberTonesV note1 wws
uniqOberSoXSynthHelpN vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
uniqOberSoXSynthHelpN2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++
prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note01 $
show 0, "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", "mix", showFFloat (Just 4) note02 $ show 0, "vol","0.5"] ""
soxSynthHelpMain note0 note1
uniqOberSoXSynthHelpN v0
uniqOberSoXSynthHelpN2 v1
mixTest) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if abs ampL1 < 0.01 then uniqOberSoXSynthN n 0.01 time3 zs wws vec0
else uniqOberSoXSynthN n ampL1 time3 zs wws vec0
uniqOberSoXSynthN3 :: Int -> Double -> Double -> String -> String -> String -> V.Vector Double -> IO ()
uniqOberSoXSynthN3 n ampL time3 zs wws tts vec0
| compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT =
let (t, ws) = splitAt 1 . syllableStr n $ zs
m = length ws
zeroN = numVZeroesPre vec0
v2 = V.map (\yy -> time3 * fromIntegral (yy * m) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = uniqOberTonesV2 note0 wws tts
v1 = uniqOberTonesV2 note1 wws tts
uniqOberSoXSynthHelpN vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
uniqOberSoXSynthHelpN2 vec = let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l * ampL) $ show 0] "") vec
soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++
prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note01 $
show 0,"synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", "mix", showFFloat (Just 4) note02 $ show 0, "vol","0.5"] ""
soxSynthHelpMain note0 note1
uniqOberSoXSynthHelpN v0
uniqOberSoXSynthHelpN2 v1
mixTest) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if abs ampL1 < 0.01 then uniqOberSoXSynthN3 n 0.01 time3 zs wws tts vec0
else uniqOberSoXSynthN3 n ampL1 time3 zs wws tts vec0
uniqOberSoXSynthN4 :: Int -> Double -> Double -> Double -> String -> String -> String -> String -> V.Vector Double -> IO ()
uniqOberSoXSynthN4 n ampL time3 dAmpl zs wws tts vs vec0
| compare (abs ampL) 0.01 /= LT && compare (abs ampL) 1.0 /= GT =
let (t, ws) = splitAt 1 . syllableStr n $ zs
m = length ws
zeroN = numVZeroesPre vec0
v3 = intervalsFromString vs
l = length vs
v2 = V.map (\yy -> time3 * fromIntegral (yy * m) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j x -> do
let note0 = closestNote x
note1 = dNote (V.unsafeIndex v3 (j `rem` l)) note0
v0 = uniqOberTonesV2 note0 wws tts
v1 = if isNothing note1 then V.empty
else uniqOberTonesV2 (fromJust note1) wws tts
uniqOberSoXSynthHelpN vec = let l1 = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine",showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l1 * ampL) $ show 0] "") vec
uniqOberSoXSynthHelpN2 vec = let l1 = V.length vec in V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,
"sine", showFFloat (Just 4) noteN $ show 0, "vol", showFFloat (Just 4) (if dAmpl * amplN / fromIntegral l * ampL > 1.0 then 1.0 else dAmpl *
amplN / fromIntegral l * ampL) $ show 0] "") vec
soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++
prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note01 $
show 0, "vol","0.5"] ""
soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" ++
prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (V.unsafeIndex v2 (j `rem` m)) $ show 0,"sine", showFFloat (Just 4) note02 $
show 0, "vol", showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / fromIntegral 2) $ show 0] ""
if isNothing note1 then do { soxSynthHelpMain0 note0
; uniqOberSoXSynthHelpN v0 }
else do { soxSynthHelpMain0 note0
; soxSynthHelpMain1 (fromJust note1)
; uniqOberSoXSynthHelpN v0
; uniqOberSoXSynthHelpN2 v1}
mixTest) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if abs ampL1 < 0.01 then uniqOberSoXSynthN4 n 0.01 time3 dAmpl zs wws tts vs vec0
else uniqOberSoXSynthN4 n ampL1 time3 dAmpl zs wws tts vs vec0
uniqOberSoXSynthNGen :: FilePath -> Int -> Double -> Double -> String -> String -> IO ()
uniqOberSoXSynthNGen file m ampL time3 zs wws = uniqOberSoXSynthNGenE file m 12 ampL time3 zs wws
uniqOberSoXSynthNGenE :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> IO ()
uniqOberSoXSynthNGenE file m ku ampL time3 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
uniqOberSoXSynthN n ampL time3 zs wws vecB
endFromResult
uniqOberSoXSynthNGen3 :: FilePath -> Int -> Double -> Double -> String -> String -> String -> IO ()
uniqOberSoXSynthNGen3 file m ampL time3 zs wws tts = uniqOberSoXSynthNGen3E file m 12 ampL time3 zs wws tts
uniqOberSoXSynthNGen3E :: FilePath -> Int -> Int -> Double -> Double -> String -> String -> String -> IO ()
uniqOberSoXSynthNGen3E file m ku ampL time3 zs wws tts = 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
uniqOberSoXSynthN3 n ampL time3 zs wws tts vecB
endFromResult
uniqOberSoXSynthNGen4 :: FilePath -> Int -> Double -> Double -> Double -> String -> String -> String -> String -> IO ()
uniqOberSoXSynthNGen4 file m ampL time3 dAmpl zs wws tts vs = uniqOberSoXSynthNGen4E file m 12 ampL time3 dAmpl zs wws tts vs
uniqOberSoXSynthNGen4E :: FilePath -> Int -> Int -> Double -> Double -> Double -> String -> String -> String -> String -> IO ()
uniqOberSoXSynthNGen4E file m ku ampL time3 dAmpl zs wws tts vs = 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
uniqOberSoXSynthN4 n ampL time3 dAmpl zs wws tts vs vecB
endFromResult