-- | -- Module : Composition.Sound.IntermediateF -- Copyright : (c) OleksandrZhabenko 2020 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- Helps to create experimental music from a file (or its part) and a Ukrainian text. -- It can also generate a timbre for the notes. Uses SoX inside. {-# OPTIONS_GHC -threaded #-} module Composition.Sound.IntermediateF ( -- * Basic functions to work with intermediate files \"result\*wav\" getFileRSizes , getFileRSizesS , getFileRSizesS2 , getFileRTuples , listVDirectory , isHighQ , shouldBeReplaced , indexesFromMrk -- * Functions to edit the melody by editing the intermediate files \"result\*\" , playAndMark , playAMrk , pAnR1 , pAnR2 , pAnR_ -- ** 2G generalized variants , playAMrk2G , pAnR12G , pAnR22G , pAnR_2G -- * Additional functions -- ** Get information , infoFromV , internalConv , ixFromRes , ixInterv , ixInterv2G , thisOne -- ** Process and Edit , playSeqAR , playSeqARV , playSeqARV2 , playCollect1Dec , playCollectDec , replaceWithHQs , isOddAsElem , maxLinV , minLinV , doubleLtoV , filterToBnds -- * 2G generalized functions , getFileRSizes2G , getFileRSizesS2G , getFileRTuples2G , listVDirectory2G -- * 3G generalized function , listVDirectory3G -- ** Process and Edit , playSeqAR2G , playSeqARV2G , playSeqARV22G , playCollectDec2G , replaceWithHQs2G -- * SoX effects application , soxBasicParams -- ** With \"reverb\" as the first -- *** No file type changes , reverbE , reverbWE , reverb1E , reverbW1E -- *** File type changes , reverbE2C , reverbWE2C , reverb1E2C , reverb1WE2C -- ** Generalized -- *** No file type changes , soxE1 , getSilenceF , fadeAllE , fadeAllEMilN -- *** File type changes , soxE2C , soxE12C -- ** Playing and recording , recE , rec1E , playE -- * 2G auxiliary functions , f2w , w2f , cfw2wf , efw2 , efw2vv , wOrf , wavToFlac , flacToWav -- * Special SoX effects , soxREw1 , soxRE1 , soxREA1 ) where import Numeric (showFFloat) import CaseBi.Arr (getBFstLSorted') import Control.Monad (void) import Control.Concurrent (myThreadId,forkIO,threadDelay,killThread) import qualified Data.List as L (sort) import Control.Exception (onException) import Sound.Control.Exception.FinalException (FinalException (NotRecorded,ExecutableNotProperlyInstalled),catchEnd) import Data.List (isPrefixOf,isSuffixOf,(\\),maximum,minimum,partition) import GHC.Arr import System.Directory import Sound.SoXBasics (durationA) import MMSyn7l import EndOfExe (showE) import System.Process (readProcessWithExitCode) import Data.Maybe (fromJust,isJust) import System.Exit (ExitCode (ExitSuccess)) import System.Info (os) import qualified Data.Foldable as F -- | Gets sizes of the \"result\*.wav\" files in the current directory. getFileRSizes :: IO (Array Int Integer) getFileRSizes = getFileRSizes2G "221w" -- | Generalized variant of the 'getFileRSizes' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to -- 'soxBasicParams'. getFileRSizes2G :: String -> IO (Array Int Integer) getFileRSizes2G ys = do dirN <- listDirectory "." let dirN1 = L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dirN dir2 <- mapM getFileSize dirN1 let l = length dir2 - 1 return (listArray (0,l) dir2) -- | Similar to 'getFileRSizes', but sizes are 'Int', not 'Integer'. For most cases it is more memory efficient. getFileRSizesS :: IO (Array Int Int) getFileRSizesS = getFileRSizesS2G "221w" -- | Generalized variant of the 'getFileRSizesS' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to -- 'soxBasicParams'. getFileRSizesS2G :: String -> IO (Array Int Int) getFileRSizesS2G ys = do dirN0 <- listDirectory "." let dirN2 = L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dirN0 l = length dirN2 - 1 sizes1 <- mapM getFileSize dirN2 return . amap fromIntegral . listArray (0,l) $ sizes1 -- | Variant of 'getFileRSizes' function. getFileRSizesS2 :: IO (Array Int Int) getFileRSizesS2 = getFileRSizes >>= \s -> return . amap fromIntegral $ s -- | Gets 'Array Int' of tuples of the pairs of \"result\*.wav\" files and their respective sizes. getFileRTuples :: IO (Array Int (FilePath,Integer)) getFileRTuples = getFileRTuples2G "221w" -- | Generalized variant of the 'getFileRTuples' with a possibility to get sizes either of FLAC or of WAV files. For more information, please, refer to -- 'soxBasicParams'. getFileRTuples2G :: String -> IO (Array Int (FilePath,Integer)) getFileRTuples2G ys = do dirN <- listDirectory "." let dirN0 = L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dirN l = length dirN0 - 1 sizes0 <- mapM getFileSize dirN0 return . listArray (0,l) . zip dirN0 $ sizes0 -- | Gets 'Array' 'Int' of the filenames for \"result\*.wav\" files in the current directory. listVDirectory :: IO [FilePath] listVDirectory = listVDirectory2G "221w" -- | Generalized variant of the 'listVDirectory' with a possibility to get 'FilePath' for either FLAC or WAV files. For more information, please, refer to -- 'soxBasicParams'. listVDirectory2G :: String -> IO [FilePath] listVDirectory2G ys = do dir0N <- listDirectory "." let diNN = L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dir0N return diNN -- | Generalized variant of the 'listVDirectory2G' with a possibility to get 'FilePath' for not only \"result\*\" files, but to specify their -- beginning with the second 'String' argument. For example: -- -- > elems . listVDirectory3G ys $ "result" == listVDirectory2G ys -- listVDirectory3G :: String -> String -> IO (Array Int FilePath) listVDirectory3G ys zs = do dir0N <- listDirectory "." let diNN = L.sort . filter (\s -> isPrefixOf zs s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dir0N l = length diNN - 1 return (listArray (0,l) diNN) -- | During function evaluation you can listen to the sound files and mark them with \"1\" and \"0\". The first one means that the sound is considered -- of higher quality and is intended to be used as a replacement for the worse sounds marked by \"0\". The function returns a 'Array' 'Int' of specially formatted -- 'String' that represents only those files that are connected with the replacement procedure. playAndMark :: [FilePath] -> IO [String] playAndMark xss = do yss <- mapM (\(xs, i) -> do putStrLn "Listen to the next sound, please. Please, do not enter anything while sound plays. " playA xs putStr "How do you mark the file that has just been played now -- if of high quality, print \"1\", if of low quality, print \"0\", " putStrLn "if it is just accepted, press \'Enter\'. " mark0 <- getLine putStrLn "-----------------------------------------------------------------------------------------" let mark = take 1 mark0 case mark of "1" -> return $ show i ++ "*" ++ xs "0" -> return $ show i ++ "**" ++ xs _ -> return []) . zip xss $ [0..] return . filter (not . null) $ yss -- | Function 'playAndMark' applied to all the \"result\*.wav\" files in the current directory. playAMrk :: IO [String] playAMrk = playAMrk2G "221w" -- | Generalized variant of the 'playAMrk' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to -- 'soxBasicParams'. playAMrk2G :: String -> IO [String] playAMrk2G ys = listVDirectory2G ys >>= playAndMark -- | Function-predicate to check whether a file corresponding to its 'String' argument is needed to be replaced while processing. shouldBeReplaced :: String -> Bool shouldBeReplaced (x:y:xs) | x == '*' && y == '*' = True | otherwise = shouldBeReplaced (y:xs) shouldBeReplaced _ = False -- | Function-predicate to check whether a file corresponding to its 'String' argument is considered as one of higher quality and therefore can be used -- to replace the not so suitable ones while processing. isHighQ :: String -> Bool isHighQ xs = (length . filter (== '*') $ xs) == 1 -- | Gets an index of the 'Array Int' element corresponding to the 'String' generated by 'playAndMark' function. indexesFromMrk :: String -> Int indexesFromMrk xs = read (takeWhile (/= '*') xs)::Int -- | Used to obtain parameters for processment. internalConv :: ([String],[String]) -> ([Int], [String]) internalConv (xss,yss) = (map indexesFromMrk xss,map (dropWhile (== '*')) yss) -- | Axiliary function to get a 'String' of consequent digits in the name of the \"result\*.wav\" file. ixFromRes :: String -> String ixFromRes xs = (takeWhile (/= '.') xs) \\ "result" -- | Given an index of the element in the 'listVDirectory' output returns a tuple of the boundaries of the indexes usable for playback. -- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1. ixInterv :: Int -> IO (Int, Int) ixInterv = ixInterv2G "221w" -- | Given an index of the element in the 'listVDirectory2G' (with the same 'String' as the second argument) output returns a tuple of the -- boundaries of the indexes usable for playback. -- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1. ixInterv2G :: String -> Int -> IO (Int, Int) ixInterv2G ys index0 | compare index0 0 == LT = do dirV <- listVDirectory2G ys let l1 = length dirV case compare l1 13 of LT -> return (0,l1 - 1) _ -> return (0,11) | compare index0 7 == LT = do dirV <- listVDirectory2G ys let l1 = length dirV case compare index0 (l1 - 5) of GT -> return (0, l1 - 1) _ -> return (0, index0 + 4) | otherwise = do dirV <- listVDirectory2G ys let l1 = length dirV case compare l1 13 of LT -> return (0,l1 - 1) _ -> case compare index0 (l1 - 5) of GT -> return (index0 - 7, l1 - 1) _ -> return (index0 - 7, index0 + 4) -- | Parser to the result of 'listVDirectory2G' function to get the needed information. infoFromV :: [String] -> [([Int], [String])] infoFromV xss = map (internalConv . unzip . map (break (== '*'))) [v1, v2] where (v1, v2) = partition shouldBeReplaced xss -- | Plays a sequence of sounds in the interval of them obtained by 'ixInterv' function. playSeqAR :: Int -> IO () playSeqAR = playSeqAR2G "221w" -- | Generalized variant of the 'playSeqAR' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to -- 'soxBasicParams'. playSeqAR2G :: String -> Int -> IO () playSeqAR2G ys index0 = do (minBnd,maxBnd) <- ixInterv2G ys index0 dirV2 <- listVDirectory3G ys "result" mapM_ (playA . unsafeAt dirV2) [minBnd..maxBnd] playA file = playE file [] {-# INLINE playA #-} -- | Plays a sequence of consequential sounds in the melody in the interval of them obtained by 'ixInterv' function for each element index -- from ['Int'] of indexes. playSeqARV :: [Int] -> IO () playSeqARV = playSeqARV2G "221w" -- | Generalized variant of the 'playSeqARV' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to -- 'soxBasicParams'. playSeqARV2G :: String -> [Int] -> IO () playSeqARV2G ys xs = do dirV2 <- listVDirectory3G ys "result" mapM_ (\x -> playA (unsafeAt dirV2 x)) xs -- | Plays a sequence of WAV sounds considered of higher quality. playSeqARV2 :: [String] -> IO () playSeqARV2 = playSeqARV22G "221w" -- | Plays a sequence of sounds considered of higher quality. playSeqARV22G :: String -> [String] -> IO () playSeqARV22G ys vec = do let indexesHQs = fst . last . infoFromV $ vec playSeqARV2G ys indexesHQs -- | The same as 'playSeqARV2', but additionally collects the resulting 'Bool' values and then returns them. It is used to define, which sounds from those of -- higher quality will replace those ones considered to be replaced. playCollectDec :: [String] -> IO [Bool] playCollectDec = playCollectDec2G "221w" -- | Generalized variant of the 'playCollectDec' with a possibility to play and mark either FLAC or WAV files. For more information, please, refer to -- 'soxBasicParams'. playCollectDec2G :: String -> [String] -> IO [Bool] playCollectDec2G ys arr = do dirV3 <- listVDirectory3G ys "result" let indexesHQs = fst . last . infoFromV $ arr mapM (playCollect1Dec dirV3) indexesHQs -- | Actually replaces the file represented by 'FilePath' argument with no (then there is no replacement at all), or with just one, -- or with a sequence of sounds being considered of higher quality to form a new melody. If the lengths of the second and the third -- arguments differs from each other then the function uses as these arguments truncated vectors of the minimal of the two lengths. replaceWithHQs :: FilePath -> [Bool] -> [FilePath] -> IO () replaceWithHQs = replaceWithHQs2G "221w" -- | Generalized variant of the 'replaceWithHQs' with a possibility to work either with FLAC files or with WAV files. -- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. replaceWithHQs2G :: String -> FilePath -> [Bool] -> [FilePath] -> IO () replaceWithHQs2G ys file0 vecBools0 stringHQs0 = do let zipp = zip vecBools0 stringHQs0 l = length zipp (vecBools, stringHQs) = unzip zipp case l of 0 -> putStrLn "That's all!" 1 | head vecBools -> do copyFile (head stringHQs) ("resultI." ++ if drop 3 ys == "f" then "flac" else "wav") renameFile ("resultI." ++ if drop 3 ys == "f" then "flac" else "wav") file0 | otherwise -> putStrLn "Nothing has changed. " _ -> do let yss = map fst . filter snd . zip stringHQs $ vecBools case length yss of 0 -> putStrLn "That's all!" 1 -> copyFile (head yss) file0 _ -> do (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (yss ++ soxBasicParams ys ["",file0]) "" putStrLn herr -- | 'IO' checkbox whether to add the sound played to the sequence of sounds that will replace the needed one. thisOne :: IO Bool thisOne = do putStrLn "Would you like to add this sound played just now to the sequence of sounds that will replace the needed one? " yes <- getLine putStrLn "-----------------------------------------------------------------------" return $ take 1 yes == "1" -- | Plays a sound file considered to be of higher quality and then you define whether to use the played sound to replace that one considered to be replaced. playCollect1Dec :: Array Int String -> Int -> IO Bool playCollect1Dec dirV2 i | i >= 0 && i <= (numElements dirV2) = do playE (unsafeAt dirV2 i) [] thisOne | otherwise = error "Composition.Sound.IntermediateF.playCollect1Dec: wrong Int parameter! " -- | Process the sound corresponding to the first element in the first argument. Returns a 'V.tail' of the first element of the first command line argument. -- Replaces (if specified) the sound with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality. pAnR1 :: [String] -> IO [String] pAnR1 = pAnR12G "221w" -- | Generalized variant of the 'pAnR1' with a possibility to work either with FLAC files or with WAV files. -- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. pAnR12G :: String -> [String] -> IO [String] pAnR12G ys vec | null vec = putStrLn "You have processed all the marked files! " >> return [] | otherwise = do let [(indexes0,strings),(indexesHQ,stringHQs)] = infoFromV vec putStrLn "Please, listen to the melody and remember what sound you would like to replace and the surrounding sounds. " playSeqAR2G ys . head $ indexes0 putStrLn "---------------------------------------------------------------" putStrLn "Now, please, listen to a collection of sounds considered of higher quality which you can use to replace the needed one. " vecBools <- playCollectDec2G ys vec replaceWithHQs2G ys (head strings) vecBools stringHQs return $ map (\(ix,xs) -> show ix ++ "**" ++ xs) . zip (drop 1 indexes0) $ (drop 1 strings) -- | Process the WAV sounds consequently corresponding to the elements in the first argument. -- Replaces (if specified) the sounds with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality for every sound needed. pAnR2 :: [String] -> IO () pAnR2 = pAnR22G "221w" -- | Generalized variant of the 'pAnR2' with a possibility to work either with FLAC files or with WAV files. -- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. pAnR22G :: String -> [String] -> IO () pAnR22G ys vec | null vec = putStrLn "You have processed all the marked files! " | otherwise = onException (pAnR12G ys vec >>= pAnR22G ys) (return ()) -- | Marks the needed WAV files as of needed to be replaced or those ones considered of higher quality that will replace the needed ones. Then actually replaces them -- as specified. Uses internally 'playAMrk' and 'pAnR2' functions. pAnR_ :: IO () pAnR_ = pAnR_2G "221w" -- | Generalized variant of the 'pAnR_' with a possibility to work either with FLAC files or with WAV files. -- Please, use with the FLAC files or with the WAV files separately. Do not intend to work with both types of them simultaneously using this function. pAnR_2G :: String -> IO () pAnR_2G ys = do vec <- playAMrk2G ys pAnR22G ys vec ---------------------------------------------------------------------------------------------------------------- -- | Takes a filename to be applied a SoX \"reverb" effect with parameters of list of 'String' (the second argument). Produces the temporary -- new file with the name ((name-of-the-file) ++ (\"reverb.wav\" OR \"reverb.flac\") -- the type is preserved), which then is removed. -- Please, remember that for the mono audio the after applied function file is stereo with 2 channels. -- -- Besides, you can specify other SoX effects after reverberation in a list of 'String'. The syntaxis is that every separate literal must be -- a new element in the list. If you plan to create again mono audio in the end of processment, then probably use 'reverb1E' funcion instead. -- If you would like to use instead of \"reverb\" its modification \"reverb -w\" effect (refer to SoX documentation), then probably it is more -- convenient to use 'reverbWE' function. Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. reverbE :: FilePath -> [String] -> IO () reverbE file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb" ++ efw2 file,"reverb"] ++ arggs) "" case code of ExitSuccess -> renameFile (file ++ "reverb" ++ efw2 file) file _ -> do removeFile $ file ++ "reverb" ++ efw2 file putStrLn $ "Composition.Sound.IntermediateF.reverbE \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Similar to 'reverbE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another -- extension and type. reverbE2C :: FilePath -> [String] -> IO () reverbE2C file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb" ++ efw2vv file,"reverb"] ++ arggs) "" case code of ExitSuccess -> do { renameFile (file ++ "reverb" ++ efw2vv file) (cfw2wf file) ; removeFile file } _ -> do { removeFile $ file ++ "reverb" ++ efw2vv file ; putStrLn $ "Composition.Sound.IntermediateF.reverbE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " } -- | The same as 'reverbE', but at the end file is being mixed to obtain mono audio. The name of the temporary file is ((name-of-the-file) ++ -- (\"reverb1.wav\" OR \"reverb1.flac\") -- the type is preserved). -- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. reverb1E :: FilePath -> [String] -> IO () reverb1E file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb1" ++ efw2 file,"reverb"] ++ arggs ++ ["channels","1"]) "" case code of ExitSuccess -> renameFile (file ++ "reverb1" ++ efw2 file) file _ -> do removeFile $ file ++ "reverb1" ++ efw2 file putStrLn $ "Composition.Sound.IntermediateF.reverb1E \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Similar to 'reverb1E', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another -- extension and type. reverb1E2C :: FilePath -> [String] -> IO () reverb1E2C file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverb1" ++ efw2vv file,"reverb"] ++ arggs ++ ["channels","1"]) "" case code of ExitSuccess -> do { renameFile (file ++ "reverb1" ++ efw2vv file) (cfw2wf file) ; removeFile file } _ -> do removeFile $ file ++ "reverb1" ++ efw2vv file putStrLn $ "Composition.Sound.IntermediateF.reverb1E2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | The same as 'reverbE', but uses \"reverb -w\" effect instead of \"reverb\". The name of the temporary file is -- ((name-of-the-file) ++ (\"reverbW.wav\" OR \"reverbW.flac\") -- the type is preserved). Please, for more information, refer to SoX documentation. -- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. reverbWE :: FilePath -> [String] -> IO () reverbWE file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW" ++ efw2 file,"reverb","-w"] ++ arggs) "" case code of ExitSuccess -> renameFile (file ++ "reverbW" ++ efw2 file) file _ -> do removeFile $ file ++ "reverbW" ++ efw2 file putStrLn $ "Composition.Sound.IntermediateF.reverbWE \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Similar to 'reverbWE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another -- extension and type. reverbWE2C :: FilePath -> [String] -> IO () reverbWE2C file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW" ++ efw2vv file,"reverb","-w"] ++ arggs) "" case code of ExitSuccess -> do { renameFile (file ++ "reverbW" ++ efw2vv file) (cfw2wf file) ; removeFile file } _ -> do { removeFile $ file ++ "reverbW" ++ efw2vv file ; putStrLn $ "Composition.Sound.IntermediateF.reverbWE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " } -- | The same as 'reverbWE', but at the end file is being mixed to obtain mono audio. The name of the temporary file is ((name-of-the-file) -- ++ (\"reverbW1.wav\" OR \"reverbW1.flac\") -- the type is preserved). Please, check by yourself whether you have enough permissions -- to read and write to the 'FilePath'-specified file and to the containing it directory. The function is not intended to be used in otherwise cases. reverbW1E :: FilePath -> [String] -> IO () reverbW1E file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW1" ++ efw2 file,"reverb","-w"] ++ arggs ++ ["channels","1"]) "" case code of ExitSuccess -> renameFile (file ++ "reverbW1" ++ efw2 file) file _ -> do removeFile $ file ++ "reverbW1" ++ efw2 file putStrLn $ "Composition.Sound.IntermediateF.reverbW1E \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Similar to 'reverb1WE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another -- extension and type. reverb1WE2C :: FilePath -> [String] -> IO () reverb1WE2C file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "reverbW1" ++ efw2vv file,"reverb","-w"] ++ arggs ++ ["channels","1"]) "" case code of ExitSuccess -> do { renameFile (file ++ "reverbW1" ++ efw2vv file) (cfw2wf file) ; removeFile file } _ -> do removeFile $ file ++ "reverbW1" ++ efw2vv file putStrLn $ "Composition.Sound.IntermediateF.reverb1WE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Is used internally in the functions to specify different SoX parameters for the sound synthesis (rate, bit depth and file extension). Possible -- file extensions are: ".wav" (a default one) and ".flac" (being lossless compressed); rates -- 8000, 11025, 16000, 22050 (a default one), 32000, -- 44100, 48000, 88200, 96000, 176400, 192000 Hz; bit depths -- 16 bits and 24 bits. The first two digits in a 'String' argument encodes rate, -- the next one -- bit depth and the last symbol -- letter \'w\' or \'f\' -- file extension. Because of SoX uses FLAC optionally, before use it, please, -- check whether your installation supports it. soxBasicParams :: String -> [String] -> [String] soxBasicParams ys xss | null xss = [] | otherwise = let (ts,zs) = splitAt 2 . init $ ys in (getBFstLSorted' "-r22050" (zip ["11","16", "17", "19", "32", "44", "48", "80", "96"] $ ["-r11025","-r16000","-r176400","-r192000","-r32000","-r44100","-r48000","-r8000","-r96000"]) ts) : (if zs == "2" then "-b24" else "-b16") : ((if drop 3 ys == "f" then map (\xs -> if drop (length xs - 4) xs == ".wav" then take (length xs - 4) xs ++ ".flac" else xs) else id) . tail $ xss) -- | Similar to 'soxE', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another -- extension and type. soxE2C :: FilePath -> [String] -> IO () soxE2C file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2vv file] ++ arggs) "" case code of ExitSuccess -> do { renameFile (file ++ "effects" ++ efw2vv file) (cfw2wf file) ; removeFile file } _ -> do removeFile $ file ++ "effects" ++ efw2vv file putStrLn $ "Composition.Sound.IntermediateF.soxE2C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | The same as 'soxE', but at the end file is being mixed to obtain mono audio. -- Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. soxE1 :: FilePath -> [String] -> IO () soxE1 file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2 file] ++ arggs ++ ["channels","1"]) "" case code of ExitSuccess -> renameFile (file ++ "effects" ++ efw2 file) file _ -> do removeFile $ file ++ "effects" ++ efw2 file putStrLn $ "Composition.Sound.IntermediateF.soxE1 \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Similar to 'soxE1', but replaces the primary WAV file with the new FLAC file (or vice versa). So if successful the resulting file has another -- extension and type. soxE12C :: FilePath -> [String] -> IO () soxE12C file arggs = do (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2vv file] ++ arggs ++ ["channels","1"]) "" case code of ExitSuccess -> do { renameFile (file ++ "effects" ++ efw2vv file) (cfw2wf file) ; removeFile file } _ -> do removeFile $ file ++ "effects" ++ efw2vv file putStrLn $ "Composition.Sound.IntermediateF.soxE12C \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " -- | Function takes a 'FilePath' for the new recorded file (if it already exists then it is overwritten) and a list of 'String'. The last one is -- sent to SoX rec or something equivalent as its arguments after the filename. If you plan just afterwards to produce mono audio, it's simpler to use -- 'rec1E' function instead. Please, check by yourself whether you have enough permissions to read and write to the 'FilePath'-specified -- file and to the containing it directory. The function is not intended to be used in otherwise cases. -- Function is adopted and changed 'SoXBasics.recA' function. recE :: FilePath -> [String] -> IO () recE file arggs | isJust (showE "sox") && take 5 os == "mingw" = do (code, _, _) <- readProcessWithExitCode (fromJust (showE "sox")) (["-t","waveaudio","-d", file] ++ arggs)"" if code /= ExitSuccess then do e0 <- doesFileExist file if e0 then do removeFile file catchEnd (NotRecorded file) else catchEnd (NotRecorded file) else do e1 <- doesFileExist file if e1 then return () else catchEnd (NotRecorded file) | isJust (showE "rec") = do (code, _, _) <- readProcessWithExitCode (fromJust (showE "rec")) (file:arggs) "" if code /= ExitSuccess then do e0 <- doesFileExist file if e0 then do removeFile file catchEnd (NotRecorded file) else catchEnd (NotRecorded file) else do e1 <- doesFileExist file if e1 then return () else catchEnd (NotRecorded file) | otherwise = catchEnd ExecutableNotProperlyInstalled -- | Function takes a 'FilePath' for the new recorded file (if it already exists then it is overwritten) and a list of 'String'. The last one is -- sent to SoX rec or something equivalent as its arguments after the filename. Please, check by yourself whether you have enough permissions -- to read and write to the 'FilePath'-specified file and to the containing it directory. The function is not intended to be used in otherwise cases. -- Function is adopted and changed 'SoXBasics.recA' function. rec1E :: FilePath -> [String] -> IO () rec1E file arggs | isJust (showE "sox") && take 5 os == "mingw" = do (code, _, _) <- readProcessWithExitCode (fromJust (showE "sox")) (["-t","waveaudio","-d", file] ++ arggs ++ ["channels","1"])"" if code /= ExitSuccess then do e0 <- doesFileExist file if e0 then do removeFile file catchEnd (NotRecorded file) else catchEnd (NotRecorded file) else do e1 <- doesFileExist file if e1 then return () else catchEnd (NotRecorded file) | isJust (showE "rec") = do (code, _, _) <- readProcessWithExitCode (fromJust (showE "rec")) ([file] ++ arggs ++ ["channels","1"]) "" if code /= ExitSuccess then do e0 <- doesFileExist file if e0 then do removeFile file catchEnd (NotRecorded file) else catchEnd (NotRecorded file) else do e1 <- doesFileExist file if e1 then return () else catchEnd (NotRecorded file) | otherwise = catchEnd ExecutableNotProperlyInstalled -- | Plays a 'FilePath' file with a SoX further effects specified by the list of 'String'. It can be e. g. used to (safely) test the result of applying -- some SoX effects and only then to use 'soxE' or some similar functions to actually apply them. -- Please, check by yourself whether you have enough permissions to read the 'FilePath'-specified -- file and the containing it directory. The function is not intended to be used in otherwise cases. -- Function is adopted and changed 'SoXBasics.playA' function. playE :: FilePath -> [String] -> IO () playE file arggs | take 5 os == "mingw" = if isJust (showE "sox") then void (readProcessWithExitCode (fromJust (showE "sox")) (filter (not . null) ([file, "-t", "waveaudio", "-d"] ++ arggs)) "") else catchEnd ExecutableNotProperlyInstalled | otherwise = if isJust (showE "play") then void (readProcessWithExitCode (fromJust (showE "play")) (filter (not . null) ([file] ++ arggs)) "") else catchEnd ExecutableNotProperlyInstalled -- | Changes the volume of the given 'FilePath' with supported by SoX sound file type so that it becomes 0 (zero). Makes so it a silence file with the -- same parameters for duration, rate, bit depth and file type. getSilenceF :: FilePath -> IO () getSilenceF file = soxE file ["vol","0"] -- | Applies 'fadeEnds' to all the \"zs*.wav\" (or instead all the \"zs*.flac\") files in the current directory. The file extension -- is defined by the first 'String' argument in accordance with 'soxBasicParams'. @zs@ here is given by the second 'String' argument. fadeAllE :: String -> String -> IO () fadeAllE ys zs = listVDirectory3G ys zs >>= \arr -> mapM_ fadeEnds . elems $ arr -- | Applies 'fadeEndsMilN' to all the \"zs*.wav\" (or instead all the \"zs*.flac\") files in the current directory. The file extension -- is defined by the first 'String' argument in accordance with 'soxBasicParams'. @zs@ here is given by the second 'String' argument. The 'Int' argument -- defines a number of miliseconds to be under fading effect (no more than 10). fadeAllEMilN :: Int -> String -> String -> IO () fadeAllEMilN n ys zs = listVDirectory3G ys zs >>= \arr -> mapM_ (fadeEndsMilN n) . elems $ arr ------------------------------------------------------------------------------------------- -- | A predicate to decide whether an element @a@ belongs to the odd number of the lists of @a@. isOddAsElem :: Eq a => a -> [[a]] -> Bool isOddAsElem x v | null v = False | otherwise = (length . filter (elem x) $ v) `rem` 2 == 1 -- | All @[a]@ must be finite. To obtain @Just a0@ as a result, at least one of the @[a]@ must be not empty and the [[a]] must have finite length. -- If the argument is [] or all @[a]@ are null (the vector has finite length), then the result is 'Nothing'. Otherwise, it will run infinitely -- just until it runs over the available memory. maxLinV :: Ord a => [[a]] -> Maybe a maxLinV v | all null v || null v = Nothing | otherwise = Just (maximum . map maximum . filter (not . null) $ v) -- | All @[a]@ must be finite. To obtain @Just a0@ as a result, at least one of the @[a]@ must be not empty and the [[a]] must have finite length. -- If the argument is [] or all @[a]@ are null (the vector has finite length), then the result is 'Nothing'. Otherwise, it will run infinitely -- just until it runs over the available memory. minLinV :: Ord a => [[a]] -> Maybe a minLinV v | all null v || null v = Nothing | otherwise = Just (minimum . map minimum . filter (not . null) $ v) -- | Applied to list of @[a]@ where a is an instance for 'Ord' class gives a sorted in the ascending order [[a]], each of them being unique. doubleLtoV :: Ord a => [[a]] -> [a] doubleLtoV = shortenL . L.sort . concat where shortenL z1@(z:_) | length (takeWhile (== z) z1) `rem` 2 == 1 = z:shortenL (dropWhile (== z) z1) | otherwise = shortenL (dropWhile (== z) z1) shortenL _ = [] -- | Filters 'Int' elements in a list so that they are limited with the first two 'Int' arguments of the function as a lower and a higher bounds. filterToBnds :: Int -> Int -> [Int] -> [Int] filterToBnds lbnd hbnd = filter (\x -> compare x lbnd /= LT && compare x hbnd /= GT) -- | Applies a special chain of the SoX effects to a file to obtain a somewhat similar to some instruments sound for some values of the 'Int' parameters. -- These last ones are used (after some normalizing transformation) as the arguments for the SoX \"reverb -w\" effect. For more information about their -- meaning, please, refer to the SoX and reverberation documentation, besides you can give them a try. soxREw1 :: Int -> Int -> Int -> Int -> Int -> Int -> FilePath -> IO () soxREw1 reverberance damping roomscale stereodepth predelay wetgain file = do durat <- durationA file soxE file (concat [["channels", "2", "rate", "44100", "reverb", "-w"], map (\n -> show (abs n `rem` 101)) [reverberance, damping, roomscale, stereodepth], [show (abs predelay `rem` 501), show (abs wetgain `rem` 7), "trim", "0", showFFloat (Just 5) durat "", "reverse", "fade", "q", "0.002", "-0.0", "earwax"]]) -- | Applies a special chain of the SoX effects to a file to obtain a somewhat other its sounding. Similar to 'soxREw1' in realization, but can give -- rather another sounding. soxRE1 :: Int -> Int -> Int -> Int -> Int -> Int -> FilePath -> IO () soxRE1 reverberance damping roomscale stereodepth predelay wetgain file = do durat <- durationA file soxE file (concat [["channels", "2", "rate", "44100", "reverb"], map (\n -> show (abs n `rem` 101)) [reverberance, damping, roomscale, stereodepth], [show (abs predelay `rem` 501), show (abs wetgain `rem` 7), "trim", "0", showFFloat (Just 5) durat "", "reverse", "fade", "q", "0.002", "-0.0", "earwax"]]) -- | Applies a special chain of the SoX effects to the files which are obtained as a result of the 'listVDirectory3G' in the current directory. -- For some values of the first six 'Int' parameters you obtain somewhat similar to some instruments sounds. -- These parameters are used (after some normalizing transformation) as the arguments for the SoX \"reverb -w\" effect. For more information about their -- meaning, please, refer to the SoX and reverberation documentation, besides you can give them a try. The last 'Int' parameter is the first argument -- for the afterwards general SoX "reverb" effect. 'String' arguments are that ones for the 'listVDirectory3G'. The 'FilePath' argument is a name -- for the resulting file (in the supported by the SoX format). soxREA1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> String -> String -> FilePath -> IO () soxREA1 reverberance damping roomscale stereodepth predelay wetgain reverb2 ys zs file = do dir0V <- listVDirectory3G ys zs let dir0L = F.toList dir0V mapM_ (soxREw1 reverberance damping roomscale stereodepth predelay wetgain) dir0L (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (concat [dir0L, [file, "reverb", show (abs reverb2 `rem` 101)]]) "" print herr