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
case arg1 of
"1" -> do
[_,_,octave,ampLS,time2] <- mapM (recAndProcess file) [1..5]
let octave1 = read octave::Int
ampL = read ampLS::Double
time3 = read time2::Double
oberSoXSynthNGen (file ++ ".wav") octave1 ampL time3 (unwords . drop 2 $ args)
_ -> do
[_,_,octave,ampLS,time2,wws] <- mapM (recAndProcess file) [1..6]
let octave1 = read octave::Int
ampL = read ampLS::Double
time3 = read time2::Double
uniqOberSoXSynthNGen (file ++ ".wav") octave1 ampL time3 (unwords . drop 2 $ args) wws
recAndProcess :: String -> Int -> IO String
recAndProcess file x
| 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
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 ++ ".wav") ;
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)