dobutokO2-0.14.0.0: DobutokO/Sound.hs
-- |
-- Module : DobutokO.Sound
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- A program and a library to create experimental music
-- from a mono audio and a Ukrainian text.
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module DobutokO.Sound (
-- * Library and executable functions
-- ** For the fixed timbre
oberTones
, oberSoXSynth
, oberSoXSynthN
-- *** For the fixed timbre with different signs for harmonics coefficients
, oberTones2
, oberSoXSynth2
, oberSoXSynthN2
, oberSoXSynthN3
-- *** Use additional parameters
, oberSoXSynthDN
, oberSoXSynth2DN
-- *** Use a file for information
, oberSoXSynthNGen
, oberSoXSynthNGen2
, oberSoXSynthNGen3
-- ** For the unique for the String structure timbre
, uniqOberTonesV
, uniqOberSoXSynth
, uniqOberSoXSynthN
-- *** For the unique for the String structure timbre with different signs for harmonics coefficients
, uniqOberTonesV2
, uniqOberSoXSynth2
, uniqOberSoXSynthN3
, uniqOberSoXSynthN4
-- *** Use a file for information
, uniqOberSoXSynthNGen
, uniqOberSoXSynthNGen3
, uniqOberSoXSynthNGen4
-- ** Work with octaves
, octavesT
, octaveUp
, octaveDown
, whichOctave
, putInOctave
, putInOctaveV
-- ** Auxiliary functions
, notes
, neighbourNotes
, closestNote
, pureQuintNote
, syllableStr
, signsFromString
, prependZeroes
, intervalsFromString
, dNote
, numVZeroesPre
) where
import CaseBi
import System.Exit (ExitCode(ExitSuccess))
import Numeric
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
import MMSyn7.Syllable
import MMSyn7s
import System.Directory
import SoXBasics
import Processing_mmsyn7ukr
import Melodics.Ukrainian
-- | 'V.Vector' of musical notes in Hz.
notes :: V.Vector Double
-- notes V.! 57 = 440.0 -- A4 in Hz
notes = V.generate 108 (\t -> fromIntegral 440 * 2 ** (fromIntegral (t - 57) / fromIntegral 12))
-- | Function returns either the nearest two musical notes if frequency is higher than one for C0 and lower than one for B8
-- or the nearest note duplicated in a tuple.
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))
-- | Returns the closest note to the given frequency in Hz.
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
-- | Returns a pure quint lower than the given note.
pureQuintNote :: Double -> Double
pureQuintNote x = x / 2 ** (fromIntegral 7 / fromIntegral 12)
{-# INLINE pureQuintNote #-}
-- | Returns an analogous note in the higher octave (its frequency in Hz).
octaveUp :: Double -> Double
octaveUp x = 2 * x
{-# INLINE octaveUp #-}
-- | Returns an analogous note in the lower octave (its frequency in Hz).
octaveDown :: Double -> Double
octaveDown x = x / fromIntegral 2
{-# INLINE octaveDown #-}
-- | Returns a 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the octaves.
octavesT :: V.Vector (Double, Double)
octavesT = V.generate 9 (\i -> (V.unsafeIndex notes (i * 12), V.unsafeIndex notes (i * 12 + 11)))
-- | Function can be used to determine to which octave (in the American notation for the notes, this is a number in the note written form,
-- e. g. for C4 this is 4) the frequency belongs (to be more exact, the closest note for the given frequency -- see 'closestNote' taking into account
-- its lower pure quint, which can lay in the lower by 1 octave). If it is not practical to determine the number, then the function returns 'Nothing'.
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
-- | Function lifts the given frequency to the given number of the octave (in American notation, from 0 to 8). This number is an 'Int' parameter.
-- The function also takes into account the lower pure quint for the closest note.
-- If it is not practical to determine the number, then the function returns '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
-- | Function lifts the 'V.Vector' of 'Double' representing frequencies to the given octave with the 'Int' number. Better to use numbers in the range [1..8].
-- The function also takes into account the lower pure quint for the obtained note behaviour. If it is not practical to determine the octave, the resulting
-- frequency is omitted from the resulting 'V.Vector'.
putInOctaveV :: Int -> V.Vector Double -> V.Vector Double
putInOctaveV n = V.mapMaybe (\z -> putInOctave n z)
-- | Function is used to generate a rhythm of the resulting file \'end.wav\' from the Ukrainian text and a number of sounds either in the syllables or in the words without vowels.
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
-- | For the given frequency of the note it generates a 'V.Vector' of the tuples, each one of which contains the harmonics' frequency and amplitude.
oberTones :: Double -> V.Vector (Double, Double)
oberTones 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 -> fromIntegral 1 / fromIntegral ((i + 1) * (i + 1))))
-- | For the given frequency of the note it generates a 'V.Vector' of the tuples, each one of which contains the harmonics' frequency and amplitude. For every given
-- 'String' structure of the uniqueness (see the documentation for @mmsyn7s@ package and its 'MMSyn7.Syllable' module) it produces the unique timbre.
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,!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
-- | Additional function to produce signs from the given 'String' of the Ukrainian text. Ukrainian vowels and voiced consonants gives \"+\" sign (+1), voiceless
-- and sonorous consonants gives \"-\" sign (-1). Voiceless2 gives "0". Other symbols are not taken into account.
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
-- | For the given frequency of the note and a Ukrainian text it generates a 'V.Vector' of the tuples, each one of which contains
-- the harmonics' frequency and amplitude. The 'String' is used to produce the signs for harmonics coefficients.
oberTones2 :: Double -> String -> V.Vector (Double, Double)
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))))
-- | For the given frequency of the note it generates a 'V.Vector' of the tuples, each one of which contains the harmonics' frequency and amplitude. For every given
-- first 'String' argument structure of the uniqueness (see the documentation for @mmsyn7s@ package and its 'MMSyn7.Syllable' module) it produces the unique timbre.
-- The second 'String' is used to produce the signs for harmonics coefficients.
uniqOberTonesV2 :: Double -> String -> String -> V.Vector (Double, Double)
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
-- | For the given frequency it generates a musical sound with a timbre. The main component of the sound includes the lower pure quint,
-- which can be in the same octave or in the one with the number lower by one. Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
oberSoXSynth :: Double -> IO ()
oberSoXSynth x = do
let note0 = if x /= 0.0 then closestNote (abs x) else V.unsafeIndex notes 0
note1 = pureQuintNote note0
v0 = oberTones note0
v1 = oberTones 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", "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
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
-- | Similar to 'oberSoXSynth' except that takes not necessarily pure lower quint note as the second one, but the one specified by the 'String' parameter
-- as an argument to 'dNote'. If you begin the 'String' with space characters, or \"сь\", or \"ць\", or dash, or apostrophe, or soft sign, than there will
-- be no interval and the sound will be solely one with its obertones.
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
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
-- | Similar to 'oberSoXSynthDN' except that the resulting duration is specified by the second 'Double' parameter in seconds. For 'oberSoXSynthDN'
-- it is equal to 0.5.
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
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
-- | For the given frequency it generates a musical sound with a timbre. The main component of the sound includes the lower pure quint,
-- which can be in the same octave or in the one with the number lower by one. Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
-- The 'String' argument is used to define signs of the harmonics coefficients for obertones.
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
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
-- | Function to create a melody for the given arguments. 'String' is used to provide a rhythm. The main component of the sound includes the lower pure quint, which
-- can be in the same octave or in the one with the number lower by one. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude
-- for obertones. If it is set to 1.0 the obertones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results
-- in their becoming more silent ones. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
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 -- zs is obtained from the command line arguments
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
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 oberSoXSynthN n 0.01 time3 zs vec0
else oberSoXSynthN n ampL1 time3 zs vec0
-- | Function to create a melody for the given arguments. 'String' is used to provide a rhythm. The main component of the sound includes the lower pure quint, which
-- can be in the same octave or in the one with the number lower by one. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude
-- for obertones. If it is set to 1.0 the obertones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results
-- in their becoming more silent ones. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
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 -- zs is obtained from the command line arguments
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
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 oberSoXSynthN2 n 0.01 time3 zs tts vec0
else oberSoXSynthN2 n ampL1 time3 zs tts vec0
-- | Function to create a melody for the given arguments. 'String' is used to provide a rhythm. The main component of the sound includes the lower pure quint, which
-- can be in the same octave or in the one with the number lower by one. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude
-- for obertones. If it is set to 1.0 the obertones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results
-- in their becoming more silent ones. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
-- The third 'String' argument is used to define the intervals for the notes if any.
-- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of
-- the main note. If it is rather great, it can signal that the volume for the second note obertones are greater than for the main note obetones.
-- The last one is experimental feature.
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 -- zs is obtained from the command line arguments
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
-- | Similar to 'oberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one. Besides, the function lifts
-- the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). The first 'Double' argument from
-- the range [0.01..1.0] is used as a maximum amplitude for obertones. If it is set to 1.0 the obertones amplitudes are just maximum ones,
-- otherwise they are multiplied by the parameter and this results in their becoming more silent ones.
-- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
--
-- For better usage the 'FilePath' should be a filepath for the .wav file.
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
(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."
-- | Similar to 'oberSoXSynthN2', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one. Besides, the function lifts
-- the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). The first 'Double' argument from
-- the range [0.01..1.0] is used as a maximum amplitude for obertones. If it is set to 1.0 the obertones amplitudes are just maximum ones,
-- otherwise they are multiplied by the parameter and this results in their becoming more silent ones.
-- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
--
-- For better usage the 'FilePath' should be a filepath for the .wav file.
-- The second 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.
oberSoXSynthNGen2 :: FilePath -> Int -> Double -> Double -> String -> String -> IO ()
oberSoXSynthNGen2 file m ampL time3 zs tts = 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
oberSoXSynthN2 n ampL time3 zs tts vecB
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."
-- | Similar to 'oberSoXSynthN2', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one. Besides, the function lifts
-- the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). The first 'Double' argument from
-- the range [0.01..1.0] is used as a maximum amplitude for obertones. If it is set to 1.0 the obertones amplitudes are just maximum ones,
-- otherwise they are multiplied by the parameter and this results in their becoming more silent ones.
-- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
--
-- For better usage the 'FilePath' should be a filepath for the .wav file.
-- The second 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.
-- The third 'String' argument is used to define the intervals for the notes if any.
-- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of
-- the main note. If it is rather great, it can signal that the volume for the second note obertones are greater than for the main note obetones.
-- The last one is experimental feature.
oberSoXSynthNGen3 :: FilePath -> Int -> Double -> Double -> Double -> String -> String -> String -> IO ()
oberSoXSynthNGen3 file m ampL time3 dAmpl zs tts vs = 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
oberSoXSynthN3 n ampL time3 dAmpl zs tts vs vecB
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."
-- | Additional function to prepend zeroes to the given 'String'. The number of them are just that one to fulfill the length to the given 'Int' parameter.
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 (log (fromIntegral x) / log 10) + 1)
{-# INLINE nOfZeroesLog #-}
-- | Is a minimal number of decimal places that are just enough to represent a length of the 'V.Vector' given. For an 'V.empty' returns 0.
numVZeroesPre :: V.Vector a -> Int
numVZeroesPre v =
let xx = nOfZeroesLog . V.length $ v in
if isJust xx
then fromJust xx
else 0::Int
{-# INLINE numVZeroesPre #-}
-- | For the given frequency and a Ukrainian text it generates a musical sound with the timbre obtained from the Ukrainian text (see the
-- documentation for @mmsyn7s@ package). The timbre for another given text usually differs, but can be the same. The last one is only
-- if the uniqueness structure and length are the same for both 'String'. Otherwise, they differs. This gives an opportunity to practically
-- and quickly synthesize differently sounding intervals. The main component of the sound includes the lower pure quint, which can be in
-- the same octave or in the one with the number lower by one. Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
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
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
-- | For the given frequency and a Ukrainian text it generates a musical sound with the timbre obtained from the Ukrainian text (see the
-- documentation for @mmsyn7s@ package). The timbre for another given text usually differs, but can be the same. The last one is only
-- if the uniqueness structure and length are the same for both 'String'. Otherwise, they differs. This gives an opportunity to practically
-- and quickly synthesize differently sounding intervals. The main component of the sound includes the lower pure quint, which can be in
-- the same octave or in the one with the number lower by one. Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
-- The second 'String' argument is used to define signs for the harmonics coefficients for obertones.
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
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
-- | Function to create a melody for the given arguments. The first 'String' is used to provide a rhythm. The second one -- to provide a timbre.
-- The timbre for another given text usually differs, but can be the same. This gives an opportunity to practically and quickly
-- synthesize differently sounding intervals. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for obertones.
-- If it is set to 1.0 the obertones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in
-- their becoming more silent ones. The main component of the sound is in the given octave with a number given
-- by 'Int' parameter. Besides, another main component of the sound includes the lower pure quint, which can be in the same octave or in the one with
-- the number lower by one. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
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 -- zs ? vec0 -- are they related to the one object? No, they are obtained from different sources.
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
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 uniqOberSoXSynthN n 0.01 time3 zs wws vec0
else uniqOberSoXSynthN n ampL1 time3 zs wws vec0
-- | Function to create a melody for the given arguments. The first 'String' is used to provide a rhythm. The second one -- to provide a timbre.
-- The timbre for another given text usually differs, but can be the same. This gives an opportunity to practically and quickly
-- synthesize differently sounding intervals. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for obertones.
-- If it is set to 1.0 the obertones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in
-- their becoming more silent ones. The main component of the sound is in the given octave with a number given
-- by 'Int' parameter. Besides, another main component of the sound includes the lower pure quint, which can be in the same octave or in the one with
-- the number lower by one. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.
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 -- zs ? vec0 -- are they related to the one object? No, they are obtained from different sources.
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
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 uniqOberSoXSynthN3 n 0.01 time3 zs wws tts vec0
else uniqOberSoXSynthN3 n ampL1 time3 zs wws tts vec0
-- | Function to create a melody for the given arguments. The first 'String' is used to provide a rhythm. The second one -- to provide a timbre.
-- The timbre for another given text usually differs, but can be the same. This gives an opportunity to practically and quickly
-- synthesize differently sounding intervals. The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for obertones.
-- If it is set to 1.0 the obertones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in
-- their becoming more silent ones. The main component of the sound is in the given octave with a number given
-- by 'Int' parameter. Besides, another main component of the sound includes the lower pure quint, which can be in the same octave or in the one with
-- the number lower by one. The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.
-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.
-- The fourth 'String' argument is used to define the intervals for the notes if any.
-- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of
-- the main note. If it is rather great, it can signal that the volume for the second note obertones are greater than for the main note obetones.
-- The last one is experimental feature.
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 -- zs ? vec0 -- are they related to the one object? No, they are obtained from different sources.
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}
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 uniqOberSoXSynthN4 n 0.01 time3 dAmpl zs wws tts vs vec0
else uniqOberSoXSynthN4 n ampL1 time3 dAmpl zs wws tts vs vec0
-- | Function is used to get numbers of intervals from a Ukrainian 'String'. It is used internally in the 'uniqOberSoXSynthN4' function.
intervalsFromString :: String -> V.Vector Int
intervalsFromString vs = vStrToVInt . convertToProperUkrainian $ vs
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 #-}
-- | Function to get from the number of semi-tones and a note a 'Maybe' note for the second lower note in the interval if any. If there is
-- no need to obtain such a note, then the result is 'Nothing'.
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))
-- | Similar to 'uniqOberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one.
-- Besides, the function lifts the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]).
-- The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for obertones. If it is set to 1.0 the
-- obertones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones.
-- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
--
-- For better usage the 'FilePath' should be a filepath for the .wav file.
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", 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 })
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
(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."
-- | Similar to 'uniqOberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one.
-- Besides, the function lifts the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]).
-- The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for obertones. If it is set to 1.0 the
-- obertones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones.
-- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
--
-- For better usage the 'FilePath' should be a filepath for the .wav file.
-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.
uniqOberSoXSynthNGen3 :: FilePath -> Int -> Double -> Double -> String -> String -> String -> IO ()
uniqOberSoXSynthNGen3 file m ampL time3 zs wws tts = 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
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
uniqOberSoXSynthN3 n ampL time3 zs wws tts vecB
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."
-- | Similar to 'uniqOberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one.
-- Besides, the function lifts the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]).
-- The first 'Double' argument from the range [0.01..1.0] is used as a maximum amplitude for obertones. If it is set to 1.0 the
-- obertones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones.
-- The second 'Double' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
--
-- For better usage the 'FilePath' should be a filepath for the .wav file.
-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.
-- The fourth 'String' argument is used to define the intervals for the notes if any.
-- The third 'Double' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of
-- the main note. If it is rather great, it can signal that the volume for the second note obertones are greater than for the main note obetones.
-- The last one is an experimental feature.
uniqOberSoXSynthNGen4 :: FilePath -> Int -> Double -> Double -> Double -> String -> String -> String -> String -> IO ()
uniqOberSoXSynthNGen4 file m ampL time3 dAmpl zs wws tts vs = 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
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
uniqOberSoXSynthN4 n ampL time3 dAmpl zs wws tts vs vecB
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."