module DobutokO.Sound (
dobutokO2
, recAndProcess
, oberTones
, oberSoXSynth
, oberSoXSynthN
, oberSoXSynthNGen
, uniqOberTonesV
, uniqOberSoXSynth
, uniqOberSoXSynthN
, uniqOberSoXSynthNGen
, octavesT
, octaveUp
, octaveDown
, whichOctave
, putInOctave
, putInOctaveV
, notes
, neighbourNotes
, closestNote
, pureQuintNote
, syllableStr
, prependZeroes
) where
import Numeric
import Control.Exception (onException)
import System.Environment (getArgs)
import Data.List (isPrefixOf,sort)
import Data.Maybe (isJust,fromJust)
import Data.Char (isDigit)
import qualified Data.Vector as V
import System.Process
import EndOfExe
import MMSyn7.Syllable
import MMSyn7s
import System.Directory
import SoXBasics
import Processing_mmsyn7ukr
notes :: V.Vector Double
notes = V.generate 108 (\t -> fromIntegral 440 * 2 ** (fromIntegral (t - 57) / fromIntegral 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
pureQuintNote :: Double -> Double
pureQuintNote x = x / 2 ** (fromIntegral 7 / fromIntegral 12)
octaveUp :: Double -> Double
octaveUp x = 2 * x
octaveDown :: Double -> Double
octaveDown x = x / fromIntegral 2
octavesT :: V.Vector (Double, Double)
octavesT = V.generate 9 (\i -> (V.unsafeIndex notes (i * 12), V.unsafeIndex notes (i * 12 + 11)))
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
putInOctave :: Int -> Double -> Maybe Double
putInOctave 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
putInOctaveV :: Int -> V.Vector Double -> V.Vector Double
putInOctaveV n = V.mapMaybe (\z -> putInOctave n z)
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
oberTones :: Double -> V.Vector (Double, Double)
oberTones note =
V.takeWhile (\w -> compare (fst w) (V.unsafeIndex notes 107) /= GT && compare (snd w) 0.001 == GT) . V.zip (V.generate 1024 (\i -> note * fromIntegral (i + 2))) $
(V.generate 1024 (\i -> fromIntegral 1 / fromIntegral ((i + 1) * (i + 1))))
uniqOberTonesV :: Double -> String -> V.Vector (Double, Double)
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 -> compare (fst u) (V.unsafeIndex notes 107) /= GT && compare (snd u) 0.001 == GT) . V.unsafeSlice 1 (z2 - 1) .
V.zip (V.generate z2 (\i -> note * fromIntegral (i + 1))) $ v2
oberSoXSynth :: Double -> IO ()
oberSoXSynth x = do
let note0 = closestNote x
note1 = pureQuintNote note0
v0 = oberTones note0
v1 = oberTones note1
oberSoXSynthHelp vec = 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 $ show 0] "") vec
oberSoXSynthHelp2 vec = 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 $ 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] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
oberSoXSynthN :: Int -> Double -> Double -> String -> V.Vector Double -> IO ()
oberSoXSynthN n ampL time3 zs vec0
| compare ampL 0.01 /= LT && compare 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 = 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 * ampL) $ show 0] "") vec
oberSoXSynthHelpN2 vec = 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 * 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] ""
soxSynthHelpMain note0 note1
oberSoXSynthHelpN v0
oberSoXSynthHelpN2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) ""
mapM_ removeFile paths ) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if ampL1 < 0.01 then oberSoXSynthN n 0.01 time3 zs vec0
else oberSoXSynthN n ampL1 time3 zs vec0
oberSoXSynthNGen :: FilePath -> Int -> Double -> Double -> String -> IO ()
oberSoXSynthNGen file m ampL time3 zs = do
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- 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
noteN1 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s
; if null noteN1 then return (11440::Int)
else let noteN2 = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 })
let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
oberSoXSynthN n ampL time3 zs vecB
path2s <- listDirectory "."
let paths3 = sort . filter (isPrefixOf "result") $ path2s
_ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
mapM_ removeFile paths3
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
nOfZeroesLog :: Int -> Maybe Int
nOfZeroesLog x
| compare x 0 /= GT = Nothing
| otherwise = Just (truncate (log (fromIntegral x) / log 10) + 1)
numVZeroesPre :: V.Vector a -> Int
numVZeroesPre v =
let xx = nOfZeroesLog . V.length $ v in
if isJust xx
then fromJust xx
else 0::Int
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 = 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 $ show 0] "") vec
uniqOberSoXSynthHelp2 vec = 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 $ 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] ""
uniqOberSoXSynthHelp v0
uniqOberSoXSynthHelp2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
uniqOberSoXSynthN :: Int -> Double -> Double -> String -> String -> V.Vector Double -> IO ()
uniqOberSoXSynthN n ampL time3 zs wws vec0
| compare ampL 0.01 /= LT && compare 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 = 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 * ampL) $ show 0] "") vec
uniqOberSoXSynthHelpN2 vec = 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 * 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] ""
soxSynthHelpMain note0 note1
uniqOberSoXSynthHelpN v0
uniqOberSoXSynthHelpN2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) ""
mapM_ removeFile paths ) vec0
| otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in
if ampL1 < 0.01 then uniqOberSoXSynthN n 0.01 time3 zs wws vec0
else uniqOberSoXSynthN n ampL1 time3 zs wws vec0
uniqOberSoXSynthNGen :: FilePath -> Int -> Double -> Double -> String -> String -> IO ()
uniqOberSoXSynthNGen file m ampL time3 zs wws = do
duration0 <- durationA file
let n = truncate (duration0 / 0.001)
vecA <- V.generateM n (\k -> do {
(_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", show (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 })
let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA
uniqOberSoXSynthN n ampL time3 zs wws vecB
path2s <- listDirectory "."
let paths3 = sort . filter (isPrefixOf "result") $ path2s
_ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
mapM_ removeFile paths3
dobutokO2 :: IO ()
dobutokO2 = do
args <- getArgs
let arg1 = concat . take 1 $ args
file = concat . drop 1 . take 2 $ args
exist2 <- doesFileExist file
case arg1 of
"1" -> do
[_,_,octave,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5] else [1..5])
let octave1 = read octave::Int
ampL = read ampLS::Double
time3 = read time2::Double
oberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args)
_ -> do
[_,_,octave,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6] else [1..6])
let octave1 = read octave::Int
ampL = read ampLS::Double
time3 = read time2::Double
uniqOberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args) wws
recAndProcess :: String -> Int -> IO String
recAndProcess file x
| x == 0 = onException (readProcessWithExitCode (fromJust (showE "sox")) [file, "x.wav", "-r22050", "channels", "1"] "" >> putStrLn "" >> return "") (do
exist <- doesFileExist "x.wav"
if exist then removeFile "x.wav"
else putStr ""
putStrLn ""
putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. "
putStrLn "Interrupt the program and start again with the valid file. "
putStrLn "_______________________________________________________________________"
recAndProcess file 0)
| x == 1 = onException (do
tempeRa 0
putStrLn "Please, specify, how many seconds long sound data you would like to record."
time <- getLine
let time0 = read (filter (\t -> isDigit t || t == '.') $ time)::Double
putStrLn "Please, wait for 0.5 second and produce the needed sound now."
recA "x.wav" time0
putStrLn ""
return "") (do
dir0 <- listDirectory "."
let paths5 = filter (isPrefixOf "nx.") dir0
mapM_ removeFile paths5
putStrLn ""
putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
putStrLn "_______________________________________________________________________"
recAndProcess file 1)
| x == 2 = onException (do
exist3 <- doesFileExist file
if exist3 then return ""
else do
putStr "Please, specify the control parameter for the SoX \"noisered\" effect in the range from 0.0 to 1.0. "
putStrLn "The greater value causes more reduction with possibly removing some important sound data. The default value is 0.5 "
putStrLn "To use the default value, you can simply press Enter."
ctrlN <- getLine
let addit = dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN
noiseP = if null ctrlN then ""
else tail addit
controlNoiseReduction $ '0':noiseP
norm "_x.wav"
if isPrefixOf "nx." file
then putStr ""
else renameFile "8_x.wav" file
removeFile "x.wav"
removeFile "_x.wav"
dir <- listDirectory "."
let paths4 = filter (isPrefixOf "nx.") dir
mapM_ removeFile paths4
putStrLn ""
return "") (do
putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
putStrLn "_______________________________________________________________________"
recAndProcess file 2)
| x == 3 = onException (do
putStr "Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) "
putStrLn "should belong. The number should be better in the range [1..8]"
octave0 <- getChar
let octave = (read [octave0]::Int) `rem` 9
return $ show octave ) (do
putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
putStrLn "_______________________________________________________________________"
recAndProcess file 3)
| x == 4 = onException (do
putStr "Please, specify the amplitude for the generated obertones as an Int number in the range [0..99]. "
putStrLn "The default one is 99"
putStrLn "To use the default value, you can simply press Enter."
amplOb0 <- getLine
if null amplOb0 then return "1.0"
else let amplOb = (read (take 2 . filter isDigit $ amplOb0)::Int) `rem` 100 in
case amplOb of
99 -> return "1.0"
_ -> if compare (amplOb `quot` 9) 1 == LT then return $ "0.0" ++ show (amplOb + 1)
else return $ "0." ++ show (amplOb + 1)) (do
putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
putStrLn "_______________________________________________________________________"
recAndProcess file 4)
| x == 5 = onException (do
putStr "Please, specify the basic duration for the generated sounds as a Double number in the range [0.1..4.0]. "
putStrLn "The default one is 0.5"
putStrLn "To use the default value, you can simply press Enter."
time0 <- getLine
if null time0 then return "0.5"
else let time1 = (read (filter (\z -> isDigit z || z == '.') $ time0)::Double) in
if compare time1 0.1 /= LT && compare time1 4.0 /= GT then return (showFFloat (Just 4) time1 $ show 0)
else let mantissa = time1 - (fromIntegral . truncate $ time1)
ceilP = (truncate time1::Int) `rem` 4 in
if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0))
else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (do
putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
putStrLn "_______________________________________________________________________"
recAndProcess file 5)
| otherwise = onException (do
putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: "
wws <- getLine
return wws) (do
putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
putStrLn "_______________________________________________________________________"
recAndProcess file 100)