Faded.hs

-- |
-- Module      :  DobutokO.Sound.Faded
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Uses SoX fade (in a special 2D way) effect and frequency modulation.

{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP #-}

module DobutokO.Sound.Faded (
  -- * Provide special faded effects and frequency modulation
  overChangeVolGN
  , overChangeVolG
  , overChangeVolGC
  , overChangeVolGF
  , overChangeVol
  , overChangeVolC
  , overChangeVolF
  , overChangeVolGCN
  , overChangeVolGFN
  , overChangeVolN
  , overChangeVolCN
  , overChangeVolFN
  -- * Mixing function
  , mixGTest
  , mixGTestN
  -- * Generate several files
  , basicFN
  , basicF
  , basicFC
  , basicF2
  , basicF2C
  , basicFCN
  , basicF2N
  , basicF2CN
  -- * Auxiliary functions
  , endingWF
  , charFadeType
  , argString
  , freqChange
) where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import System.Exit (ExitCode (ExitSuccess))
import Data.List (isPrefixOf,isSuffixOf)
import Data.Maybe (fromJust)
import System.Process
import EndOfExe (showE)
import MMSyn7l (fadeEndsTMB,fadeEndsTMN)
import Numeric (showFFloat)
import qualified Data.Vector as V
import System.Directory
import DobutokO.Sound.Functional.Basics
import DobutokO.Sound.IntermediateF (soxBasicParams)
import Data.Vector.DoubleZip (evalSndFV)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

-- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points at the time-volume scale with possibly 
-- changing frequency (they are specified by the first and the second 'Double' arguments). Uses SoX inside especially the \"fade\" and \"synth\" effects. 
-- For the equal frequencies generates specifically faded output without frequency modulation. 
overChangeVolG :: String -> String -> Int -> Double -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO ()
overChangeVolG = overChangeVolGN "test"
 
-- | A generalized version of the 'overChangeVolGN' with a possibility to specify the name of the resulting file (by default it is \"test\" based).
overChangeVolGN :: FilePath -> String -> String -> Int -> Double -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO ()
overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta ((t0,v0), (t1,v1)) 
 | x0 /= 0 && compare (abs x0) 1.0 /= GT && compare freq1 16 == GT && compare freq1 20000 == LT = 
  case compare (v1 * v0) 0 of 
    GT -> do
     (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test1.wav","synth", 
       showFFloat Nothing (if t1 == t0 then abs x0 else abs (t1 - t0)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", 
        charFadeType (if null cs then 'l' else head cs)] ++ 
         if compare ((v1 - v0) * (t1 - t0)) 0 /= LT then [showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""] 
           else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "vol", 
             showFFloat (Just 4) (signum v1 * abs (v1 - v0)) ""]) ""
     if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1
     else do
      (code2,_,herr2) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test0.wav","synth", 
        showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", 
          showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "vol", showFFloat (Just 4) (min v0 v1) ""]) ""
      if code2 == ExitSuccess 
        then do
          (code3,_,herr3) <- readProcessWithExitCode (fromJust (showE "sox")) ["-m","test0" ++ endingWF ys,"test1" ++ endingWF ys, (filestart ++ "G") ++ 
            prependZeroes 6 (show j) ++ endingWF ys, "vol", "2"] ""
          if code3 == ExitSuccess 
            then removeFile ("test0" ++ endingWF ys) >> removeFile ("test1" ++ endingWF ys)
            else error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr3
        else print herr2 >> error "DobutokO.Sound.Faded.overChangeVolGN: Operation not successful. "
    LT -> do  
     overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta ((t0,v0), ((v0 * t1 - v1 * t0) / (v0 - v1),0)) >> renameFile ((filestart ++ "G") ++ 
       prependZeroes 6 (show j) ++ endingWF ys) ("temp0" ++ endingWF ys)
     overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> renameFile ((filestart ++ "G") ++ 
       prependZeroes 6 (show j) ++ endingWF ys) ("temp1" ++ endingWF ys)
     (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp0" ++ endingWF ys,"temp1" ++ endingWF ys, (filestart ++ "G") ++ 
       prependZeroes 6 (show j) ++ endingWF ys] ""
     if code1 == ExitSuccess then removeFile ("temp0" ++ endingWF ys) >> removeFile ("temp1" ++ endingWF ys)
     else error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1 
    _  -> 
     case v1 of 
      0 -> 
       if v0 == 0 
        then do
          (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ 
            ".wav","delay", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "trim", showFFloat Nothing 
              (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""]) ""
          if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1
          else return ()
        else do 
          (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ 
            ".wav","synth", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", 
              showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ 
               if compare t0 t1 == GT then [showFFloat Nothing 
                (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""] else ["0", "-0.0", showFFloat Nothing 
                  (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "vol", showFFloat (Just 4) v0 ""]) ""
          if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1
          else return ()
      _ -> do
       (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ ".wav",
         "synth", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", 
          showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ 
           if compare t1 t0 == GT 
            then [showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 
             else abs (t1 - t0)) ""] else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", 
               "vol", showFFloat (Just 4) v1 ""]) ""
       if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1
       else return ()
 | otherwise = error "DobutokO.Sound.Faded.overChangeVolGN: sound for these conditions is not defined. " 

freqChange :: String -> Double -> Double -> String
freqChange xs freq freq1 
 | compare freq 16 /= LT && compare freq 20000 /= GT = if freq /= freq1 then
   case xs of 
    "l" -> ':':showFFloat (Just 4) freq ""
    "s" -> '+':showFFloat (Just 4) freq ""
    "e" -> '/':showFFloat (Just 4) freq ""
    _ -> '-':showFFloat (Just 4) freq "" 
     else ""
 | otherwise = error "DobutokO.Sound.Faded.freqChange: undefined for this value of the frequency (the first Double argument). "

-- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points at the time-volume scale. Uses SoX inside 
-- especially the \"fade\" and \"synth\" effects. A frequency does not change and is specified (in Hz) by the first 'Double' argument.
overChangeVol :: String -> Char -> Int -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO () 
overChangeVol ys c j freq1 = overChangeVolGN "test" ys [c] j freq1 freq1

-- | A generalized version of the 'overChangeVol' with a possibility to specify the name for the mixed files (by default is \"test\" based).
overChangeVolN :: FilePath -> String -> Char -> Int -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO () 
overChangeVolN filestart ys c j freq1 = overChangeVolGN filestart ys [c] j freq1 freq1

-- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale. Uses SoX inside especially 
-- the \"fade\" and \"synth\" effects. A frequency does not change and is specified (in Hz) by the first 'Double' argument. Is a curried variant of the 
-- 'overChangeVol' in its two last arguments.
overChangeVolC :: String -> Char -> Int -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO ()
overChangeVolC ys c j freq x0 xdelta w1 = overChangeVol ys c j freq x0 xdelta . (,) w1

-- | A generalized version of the 'overChangeVolC' with a possibility to specify the name for the mixed files (by default is \"test\" based).
overChangeVolCN :: FilePath -> String -> Char -> Int -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO ()
overChangeVolCN filestart ys c j freq x0 xdelta w1 = overChangeVolN filestart ys c j freq x0 xdelta . (,) w1

-- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale with possibly changing frequency (they are specified by 
-- the first and the second 'Double' arguments). Uses SoX inside especially the \"fade\" and \"synth\" effects. For the equal frequencies generates specifically 
-- faded output without frequency modulation. Is a curried variant of the 'overChangeVolG' in its two last arguments.
overChangeVolGC :: String -> String -> Int -> Double -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO ()
overChangeVolGC ys cs j freq1 freq2 x0 xdelta w1 = overChangeVolG ys cs j freq1 freq2 x0 xdelta . (,) w1

-- | A generalized version of the 'overChangeVolGC' with a possibility to specify the name for the mixed files (by default is \"test\" based).
overChangeVolGCN :: FilePath -> String -> String -> Int -> Double -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO ()
overChangeVolGCN filestart ys cs j freq1 freq2 x0 xdelta w1 = overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta . (,) w1

-- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale. Uses SoX inside especially 
-- the \"fade\" and \"synth\" effects. Is a somewhat flipped variant of the 'overChangeVol' with changed order of the arguments (is provided here 
-- for convenience).
overChangeVolF :: String -> Char -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) ->  Double -> IO ()
overChangeVolF ys c j x0 xdelta w1 w2 freq  = overChangeVol ys c j freq x0 xdelta (w1,w2)

-- | A generalized version of the 'overChangeVolF' with a possibility to specify the name for the mixed files (by default is \"test\" based).
overChangeVolFN :: FilePath -> String -> Char -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) ->  Double -> IO ()
overChangeVolFN filestart ys c j x0 xdelta w1 w2 freq  = overChangeVolN filestart ys c j freq x0 xdelta (w1,w2)

-- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale with possibly 
-- changing frequency (they are specified by the first and the second 'Double' arguments). Uses SoX inside especially the \"fade\" and \"synth\" effects. 
-- For the equal frequencies generates specifically faded output without frequency modulation. Is a somewhat flipped variant of the 'overChangeVolGC' 
-- with changed order of the arguments (is provided here for convenience).
overChangeVolGF :: String -> String -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) ->  Double -> Double -> IO ()
overChangeVolGF ys cs j x0 xdelta w1 w2 freq1 freq2  = overChangeVolG ys cs j freq1 freq2 x0 xdelta (w1,w2)

-- | A generalized version of the 'overChangeVolGF' with a possibility to specify the name for the mixed files (by default is \"test\" based).
overChangeVolGFN :: FilePath -> String -> String -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) ->  Double -> Double -> IO ()
overChangeVolGFN filestart ys cs j x0 xdelta w1 w2 freq1 freq2  = overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta (w1,w2)

-- | A simplified variant of the 'soxBasicParameters' function with defining only a file extension.
endingWF :: String -> String
endingWF ys 
 | not (null ys) = if last ys == 'f' then ".flac" else ".wav"
 | otherwise = ".wav"

-- | Converts a character into a corresponding string using \"l\" (a logarithmic one) as the default one. An output can specify then the fade type for SoX.
charFadeType :: Char -> String
charFadeType c = 
  case c of
   'h' -> "h"
   'p' -> "p"
   't' -> "t"
   _  -> "l"

-- | Using SoX mixes all the \"testG*\" (of the WAV or FLAC extension specified by the 'String' argument -- see 'endingWF') in the current directory. 
-- If there are \"resultG.*" (wav or flac respectively) file in the directory, it is overwritten. Also the "testG*" files are deleted afterwards if the 
-- mixing is successful.
mixGTest :: String -> IO ()
mixGTest ys = do
  dir <- listDirectory "."
  (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (mconcat [["-m"], filter (\xs -> "testG" `isPrefixOf` xs && 
    endingWF ys `isSuffixOf` xs) dir, ["resultG" ++ endingWF ys]]) ""
  if code1 /= ExitSuccess then error $ "DobutokO.Sound.Times.mixGTest: " ++ herr1
  else mapM_ removeFile . filter (\xs -> "testG" `isPrefixOf` xs && endingWF ys `isSuffixOf` xs) $ dir

-- | A generalized version of the 'mixGTest' with a possibility to specify the name for the mixed files (by default is \"test\" based).
mixGTestN :: FilePath -> String -> IO ()
mixGTestN filestart ys = do
  dir <- listDirectory "."
  (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (mconcat [["-m"], filter (\xs -> (filestart ++ "G") `isPrefixOf` xs && 
    endingWF ys `isSuffixOf` xs) dir, ["resultG" ++ endingWF ys]]) ""
  if code1 /= ExitSuccess then error $ "DobutokO.Sound.Times.mixGTestN: " ++ herr1
  else mapM_ removeFile . filter (\xs -> (filestart ++ "G") `isPrefixOf` xs && endingWF ys `isSuffixOf` xs) $ dir  
  
-- | Generates a sequence of sounds using 'overChangeVol' so that their time-volume characteristic is going through the 2D points obtained 
-- with the last two arguments.
-- Uses 'fadeEndsTMB', the arguments for which are specified by the second symbol in the second 'String' and by the third 'Double' argument.
basicF :: String -> String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicF ys x2s freq x0 xdelta per f v = do
  let (xs1,xs2) = splitAt 1 x2s
      c1 = if null xs1 then 'l' else head xs1
      c2 = if null xs2 then 'l' else head xs2
  v1 <- evalSndFV f v
  V.imapM_ (\i x -> do
    overChangeVol ys c1 i freq x0 xdelta x
    fadeEndsTMB c2 per $ "testG" ++ prependZeroes 6 (show i) ++ endingWF ys) v1

-- | A generalized version of the 'basicF' with a possibility to specify the name for the generated files (by default is \"test\" based).
basicFN :: FilePath -> String -> String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicFN filestart ys x2s freq x0 xdelta per f v = do
  let (xs1,xs2) = splitAt 1 x2s
      c1 = if null xs1 then 'l' else head xs1
      c2 = if null xs2 then 'l' else head xs2
  v1 <- evalSndFV f v
  V.imapM_ (\i x -> do
    overChangeVolGN filestart ys [c1] i freq freq x0 xdelta x
    fadeEndsTMB c2 per $ (filestart ++ "G") ++ prependZeroes 6 (show i) ++ endingWF ys) v1

-- | Splits its argument (the first six symbols if present) (like 'splitAt') into two 'String' with the length of (if possible) 4 and 2 characters. 
-- The rest of the argument is not used.
argString :: String -> (String,String)
argString xs = (take 4 xs,take 2 . drop 4 $ xs)

-- | Generates a sequence of sounds using 'overChangeVol' so that their time-volume characteristic (if being plotted graphically) is going through 
-- the 2D points obtained with the last two arguments.
-- The 'String' should consist of 6 alphanumeric characters. The first four as for the 'soxBasicParams', and the fifth one -- a letter from the \"hlpqt\". The 
-- sixth one is one of the \"els\" or some other symbol.
-- Otherwise, the default values are used (\"221w\" for the first and \"ll\" for the second one).
basicFC :: String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicFC = basicFCN "test"

-- | A generalized version of the 'basicFC' with a possibility to specify the name for the mixed files (by default is \"test\" based).
basicFCN :: FilePath -> String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicFCN filestart xs freq x0 xdelta per f v = let (ys,x2s) = argString xs in basicFN filestart ys x2s freq x0 xdelta per f v

-- | Generates a sequence of sounds using 'overChangeVol' so that their time-volume characteristic (if being plotted graphically) is going through the 2D points obtained 
-- with the last two arguments.
-- Uses 'fadeEndsTMN', the arguments for which are specified by the second symbol in the second 'String' and by the third and fourth 'Double' arguments.
basicF2 :: String -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicF2 = basicF2N "test"

-- | A generalized version of the 'basicF2' with a possibility to specify the name for the mixed files (by default is \"test\" based).
basicF2N :: FilePath -> String -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicF2N filestart ys x2s freq x0 xdelta per1 per2 f v = do
  let (xs1,xs2) = splitAt 1 x2s
      c1 = if null xs1 then 'l' else head xs1
      c2 = if null xs2 then 'l' else head xs2
  v1 <- evalSndFV f v
  V.imapM_ (\i x -> do
    overChangeVolN filestart ys c1 i freq x0 xdelta x
    fadeEndsTMN c2 per1 per2 $ (filestart ++ "G") ++ prependZeroes 6 (show i) ++ endingWF ys) v1    

-- | Generates a sequence of sounds using 'overChangeVol' so that their time-volume characteristic (if being plotted graphically) is going through 
-- the 2D points obtained with the last two arguments.
-- The 'String' should consist of 6 alphanumeric characters. The first four as for the 'soxBasicParams' and the the fifth one -- a letter 
-- from the \"hlpqt\". The sixth one is one of the \"els\" or some other symbol. Otherwise, the default values are used (\"221w\" for the first 
-- and \"ll\" for the second one).
basicF2C :: String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicF2C = basicF2CN "test"

-- | A generalized version of the 'basicF2C' with a possibility to specify the name for the mixed files (by default is \"test\" based).
basicF2CN :: FilePath -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO ()
basicF2CN filestart xs freq x0 xdelta per1 per2 f v = let (ys,x2s) = argString xs in basicF2N filestart ys x2s freq x0 xdelta per1 per2 f v