-- |
-- 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 the 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
  , oberSoXSynthNGen
  -- ** For the unique for the String structure timbre
  , uniqOberTonesV
  , uniqOberSoXSynth
  , uniqOberSoXSynthN
  , uniqOberSoXSynthNGen
  -- ** Auxiliary functions
  , notes
  , neighbourNotes
  , closestNote
  , pureQuintNote
  , syllableStr
  , prependZeroes
  , nOfZeroesLog
  , numVZeroesPre
) where

import Control.Exception (onException)
import System.Environment (getArgs)
import Data.List (isPrefixOf,sort)
import Data.Maybe (isJust,fromJust)
import Data.Char (isDigit)
import qualified Data.Vector as V
import System.Process
import EndOfExe
import MMSyn7.Syllable
import MMSyn7s
import System.Directory
import SoXBasics
import Processing_mmsyn7ukr

-- | '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 a nearest two musical notes if note is higher than C0 and lower than B8 or a 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)

-- | Function is used to generate a rhythm of the resulting file from the Ukrainian text and number of sounds in the syllables or 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

-- | For the given frequency it generates a musical sound with a timbre. 
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", show noteN, "vol", show amplN] "") vec
      oberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
        ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", show noteN, "vol", show amplN] "") vec
  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", show note0, "synth", "0.5","sine", "mix", show note1] ""
  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.
oberSoXSynthN :: Int -> String -> V.Vector Double -> IO ()
oberSoXSynthN n zs vec0 = 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
      (t, ws) = splitAt 1 . syllableStr n $ zs
      zeroN = numVZeroesPre vec0
      v2    = V.map (\yy -> 0.5 * fromIntegral (yy * n) / fromIntegral (head t)) . V.fromList $ ws
      oberSoXSynthHelpN vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
        ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec
      oberSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
        ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec
  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN "1" ++  ".wav", "synth", "0.5","sine", show note0, "synth", "0.5","sine", "mix", show 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

-- | Similar to 'oberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one.
oberSoXSynthNGen :: FilePath -> String -> IO ()
oberSoXSynthNGen file 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", show (fromIntegral k * 0.001),
    "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 = V.map (closestNote . fromIntegral) . V.filter (/= (11440::Int)) $ vecA
  oberSoXSynthN n zs 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 the another given text usually is another one, 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 notes.
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", show noteN, "vol", show amplN] "") vec
      uniqOberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
        ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", show noteN, "vol", show amplN] "") vec
  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test-.wav", "synth", "0.5","sine", show note0, "synth", "0.5","sine", "mix", show note1] ""
  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 the another given text usually is another one, but can be the same. This gives an opportunity to practically and quickly
-- synthesize differently sounding notes.
uniqOberSoXSynthN :: Int -> String -> String -> V.Vector Double -> IO ()
uniqOberSoXSynthN n zs wws vec0 = 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
      (t, ws) = splitAt 1 . syllableStr n $ zs
      zeroN = numVZeroesPre vec0
      v2    = V.map (\yy -> 0.5 * fromIntegral (yy * n) / fromIntegral (head t)) . V.fromList $ ws
      uniqOberSoXSynthHelpN vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
        ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec
      uniqOberSoXSynthHelpN2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
        ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", show (V.unsafeIndex v2 i),"sine", show noteN, "vol", show amplN] "") vec
  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ prependZeroes zeroN "1" ++  ".wav", "synth", "0.5","sine", show note0, "synth", "0.5","sine", "mix", show 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

-- | Similar to 'uniqOberSoXSynthN', but uses a sound file to obtain the information analogous to 'V.Vector' in the latter one.
uniqOberSoXSynthNGen :: FilePath -> String -> String -> IO ()
uniqOberSoXSynthNGen file 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 = V.map (closestNote . fromIntegral) . V.filter (/= (11440::Int)) $ vecA
  uniqOberSoXSynthN n zs wws 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.
dobutokO2 :: IO ()
dobutokO2 = do
  args <- getArgs
  let arg1 = concat . take 1 $ args
      file = concat . drop 1 . take 2 $ args
  case arg1 of
    "1" -> do
      mapM_ (recAndProcess file) [1,2]
      oberSoXSynthNGen (file ++ ".wav") (unwords . drop 2 $ args)
    _ -> do
      [_,_,wws] <- mapM (recAndProcess file) [1..3]
      putStrLn $ "wws: " ++ wws
      uniqOberSoXSynthNGen (file ++ ".wav") (unwords . drop 2 $ args) wws

-- | Function records and process the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function.
recAndProcess :: String -> Int -> IO String
recAndProcess file x
  | x == 1 = onException (do
     tempeRa 0
     putStrLn "Please, specify, how many seconds long sound data you would like to record."
     time <- getLine
     let time0 = read (filter (\t -> isDigit t || t == '.') $ time)::Double
     putStrLn "Please, wait for 0.5 second and produce the needed sound now."
     recA "x.wav" time0
     putStrLn ""
     return "") (do
       dir0 <- listDirectory "."
       let paths5 = filter (isPrefixOf "nx.") dir0
       mapM_ removeFile paths5
       putStrLn ""
       putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
       putStrLn "_______________________________________________________________________"
       recAndProcess file 1)
  | x == 2 = onException (do
     putStr "Please, specify the control parameter for the SoX \"noisered\" effect in the range from 0.0 to 1.0. "
     putStrLn "The greater value causes more reduction with possibly removing some inmportant sound data. The default value is 0.5"
     ctrlN <- getLine
     putStrLn $ "ctrlN: " ++ ctrlN
     let noiseP = tail . dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN
     controlNoiseReduction $ '0':noiseP
     norm "_x.wav"
     if isPrefixOf "nx." file
       then putStr ""
       else renameFile "8_x.wav" (file ++ ".wav")
     removeFile "x.wav"
     removeFile "_x.wav"
     dir <- listDirectory "."
     let paths4 = filter (isPrefixOf "nx.") dir
     mapM_ removeFile paths4
     putStrLn ""
     return "") (do
       putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
       putStrLn "_______________________________________________________________________"
       recAndProcess file 2)
  | otherwise = onException (do
     putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: "
     wws <- getLine
     putStrLn wws
     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 3)