-- |
-- 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.

module DobutokO.Sound (
  -- * Basic functions for the executable
  dobutokO2
  , recAndProcess
  -- * 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
  -- *** Uses 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
  -- *** Uses a file for information
  , uniqOberSoXSynthNGen
  , uniqOberSoXSynthNGen3
  -- ** Work with octaves
  , octavesT
  , octaveUp
  , octaveDown
  , whichOctave
  , putInOctave
  , putInOctaveV
  -- ** Auxiliary functions
  , notes
  , neighbourNotes
  , closestNote
  , pureQuintNote
  , syllableStr
  , signsFromString
  , prependZeroes
  , intervalsFromString
  , dNote
) where

import CaseBi
import Numeric
import Control.Exception (onException)
import System.Environment (getArgs)
import Data.List (isPrefixOf,sort)
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)

-- | Returns an analogous note in the higher octave (its frequency in Hz).
octaveUp :: Double -> Double
octaveUp x = 2 * x

-- | Returns an analogous note in the lower octave (its frequency in Hz).
octaveDown :: Double -> Double
octaveDown x = x / fromIntegral 2

-- | 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 -> 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))))

-- | 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 -> 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

-- | 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 -> compare (fst w) (V.unsafeIndex notes 107) /= GT && compare (abs . snd $ w) 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 -> compare (fst u) (V.unsafeIndex notes 107) /= GT && compare (abs . snd $ u) 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 = 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

-- | 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.
-- 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 = 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

-- | 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*\" and \"end.wav\" 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 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                     -- zs is obtained from the command line arguments
              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

-- | 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*\" and \"end.wav\" 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 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                     -- zs is obtained from the command line arguments
              note1 = pureQuintNote note0
              v0    = oberTones2 note0 tts
              v1    = oberTones2 note1 tts
              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 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*\" and \"end.wav\" 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 ampL 0.01 /= LT && compare 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 = 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) (if dAmpl * amplN * ampL > 1.0 then 1.0 else dAmpl * amplN * 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] ""
              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 > 1.0 then 1.0 else dAmpl) $ 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 ++ ["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 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
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
  mapM_ removeFile paths3

-- | 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
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
  mapM_ removeFile paths3

-- | 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
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
  mapM_ removeFile paths3

-- | 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

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

-- | 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*\" and \"end.wav\" 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 = 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

-- | 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*\" and \"end.wav\" 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 = 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

-- | 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*\" and \"end.wav\" 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 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                         -- 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 = 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

-- | 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*\" and \"end.wav\" 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 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                         -- 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 = 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 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*\" and \"end.wav\" 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 ampL 0.01 /= LT && compare 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 = 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) (if dAmpl * amplN * ampL > 1.0 then 1.0 else dAmpl * amplN * 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] ""
              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 > 1.0 then 1.0 else dAmpl) $ 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 ++ ["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 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)])

-- | 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", 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

-- | 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", 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
  uniqOberSoXSynthN3 n ampL time3 zs wws tts vecB
  path2s <- listDirectory "."
  let paths3 = sort . filter (isPrefixOf "result") $ path2s
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
  mapM_ removeFile paths3

-- | 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 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", 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
  uniqOberSoXSynthN4 n ampL time3 dAmpl zs wws tts vs vecB
  path2s <- listDirectory "."
  let paths3 = sort . filter (isPrefixOf "result") $ path2s
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
  mapM_ removeFile paths3

-- | Function that actually makes processing in the @dobutokO2@ executable. 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.
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)
    "2" -> 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
    "3" -> do
      [_,_,octave,ampLS,time2,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7] else [1,2,3,4,5,7])
      let octave1 = read octave::Int
          ampL = read ampLS::Double
          time3 = read time2::Double
      oberSoXSynthNGen2 file octave1 ampL time3 (unwords . drop 2 $ args) tts
    "4" -> do
      [_,_,octave,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7] else [1..7])
      let octave1 = read octave::Int
          ampL = read ampLS::Double
          time3 = read time2::Double
      uniqOberSoXSynthNGen3 file octave1 ampL time3 (unwords . drop 2 $ args) wws tts
    "5" -> do
      [_,_,octave,ampLS,time2,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7,8,9] else [1,2,3,4,5,7,8,9])
      let octave1 = read octave::Int
          ampL = read ampLS::Double
          time3 = read time2::Double
          dAmpl = read dAmpl0::Double
      oberSoXSynthNGen3 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) tts vs
    _   -> do
      [_,_,octave,ampLS,time2,wws,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7,8,9] else [1..9])
      let octave1 = read octave::Int
          ampL = read ampLS::Double
          time3 = read time2::Double
          dAmpl = read dAmpl0::Double
      uniqOberSoXSynthNGen4 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) wws tts vs

-- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing
-- whether there is no \"x.wav\" file in the current directory, because it can be overwritten.
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)
  | x == 7 = onException (do
     putStrLn "Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: "
     tts <- getLine
     if null tts then return "або"
     else return tts) (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 7)
  | x == 8 = onException (do
     putStr "Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. "
     putStrLn "The number is in the range [0.1..2.0]. The default one is 1.0"
     putStrLn "To use the default value, you can simply press Enter."
     dAmpl0 <- getLine
     if null dAmpl0 then return "1.0"
     else let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') $ dAmpl0)::Double) in
          if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then return (showFFloat (Just 4) dAmpl1 $ show 0)
          else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1)
                   ceilP    = (truncate dAmpl1::Int) `rem` 2 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 8)
  | x == 9 = onException (do
     putStrLn "Please, input the Ukrainian text that will be used to define intervals to be used to produce the lower note for the given main one. "
     putStrLn "The default one is \"й\". "
     putStrLn "To use the default value, you can simply press Enter."
     vs <- getLine
     if null vs then return "й"
     else return vs) (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 9)
  | 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)