-- | -- 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 -- * Generate several files with frequency modulation , moreFN , moreFCN -- * 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 'overChangeVolG' 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 -- | A generalized version of the 'basicFN' with a frequency modulation. moreFN :: FilePath -> String -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () moreFN filestart ys x2s freq1 freq2 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 freq1 freq2 x0 xdelta x fadeEndsTMB c2 per $ (filestart ++ "G") ++ prependZeroes 6 (show i) ++ endingWF ys) v1 -- | A generalized version of the 'basicFCN' with a frequency modulation. moreFCN :: FilePath -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () moreFCN filestart xs freq1 freq2 x0 xdelta per f v = let (ys,x2s) = argString xs in moreFN filestart ys x2s freq1 freq2 x0 xdelta per f v