diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,3 +24,9 @@ * Second version revised B. Fixed issue with being not imported iterate' from GHC.List for lower than 8.6 versions of GHC. + +## 0.3.0.0 -- 2021-03-07 + +* Third version. Fixed some issues with functions in the Composition.Sound.IntermediateF module. Added a new function to it +and some other new functions to the Composition.Sound.Functional.Basics module. Added process-sequential as a new lightweight +dependency. diff --git a/Composition/Sound/Functional/Basics.hs b/Composition/Sound/Functional/Basics.hs --- a/Composition/Sound/Functional/Basics.hs +++ b/Composition/Sound/Functional/Basics.hs @@ -1,6 +1,6 @@ -- | -- Module : Composition.Sound.Functional.Basics --- Copyright : (c) OleksandrZhabenko 2020 +-- Copyright : (c) OleksandrZhabenko 2020-2021 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com @@ -31,6 +31,8 @@ -- ** Generalized functions , overSoXSynthG , overSoXSynthGG + , overSoXSynth3G + , overSoXSynth4G -- * Work with enky (extension to octaves functionality) , nkyT , whichOctave @@ -67,6 +69,7 @@ import CaseBi.Arr (getBFstLSorted') import Data.Char (isDigit) import System.Exit (ExitCode( ExitSuccess )) +import System.IO (stderr,hPutStrLn) import Numeric import Data.List (isPrefixOf,sort) import Data.Maybe (fromJust,isJust,fromMaybe,mapMaybe) @@ -108,16 +111,19 @@ let paths = filter (isPrefixOf "test") $ paths0 l = length paths if l <= 100 then do - _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav"]) "" - return () + (code,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav"]) "" + if code == ExitSuccess then return () + else hPutStrLn stderr herr else do let zipp = intoHundreds paths ress <- mapM (\(i, hundList) -> readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ hundList ++ ["result" ++ prependZeroes 20 (show i) ++ ".wav"]) "" >> return ("result" ++ prependZeroes l (show i) ++ ".wav")) . zip [0..] $ zipp - _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ ress ++ ["result.wav"]) "" - ress2 <- listDirectory "." - let ress3 = filter (isPrefixOf "result0") ress2 - mapM_ removeFile ress3 - mapM_ removeFile paths + (code,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ ress ++ ["result.wav"]) "" + if code == ExitSuccess then do + ress2 <- listDirectory "." + let ress3 = filter (isPrefixOf "result0") ress2 + mapM_ removeFile ress3 + mapM_ removeFile paths + else hPutStrLn stderr herr intoHundreds :: [a] -> [[a]] intoHundreds xs @@ -396,8 +402,31 @@ overSoXSynthHelpG j = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test" ++ show j ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") . zip [0..] mapM_ (\(j, vel) -> overSoXSynthHelpG j vel) . zip [0..] $ vs - mixTest + mixTest +-- | Generalized variant of the 'overSoXSynthGG' with the possibility to set the duration for the generated sound. +overSoXSynth3G :: [(Float -> Float)] -> (Float -> OvertonesO) -> Float -> Float -> IO () +overSoXSynth3G progressionHarmonizerList g duration x = do + let !note0 = if x /= 0.0 then closestNote (abs x) else unsafeAt notes 0 + !notes1 = map (\f -> f note0) progressionHarmonizerList + !vs = map g (note0 : notes1) + overSoXSynthHelpG j = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox")) + ["-r22050", "-n", "test" ++ show j ++ show (i + 2) ++ ".wav", "synth", showFFloat Nothing duration "", "sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") . zip [0..] + mapM_ (\(j, vel) -> overSoXSynthHelpG j vel) . zip [0..] $ vs + mixTest + + +-- | Generalized variant of the 'overSoXSynth3G' with the possibility to set the sound rate. +overSoXSynth4G :: [(Float -> Float)] -> (Float -> OvertonesO) -> String -> Float -> Float -> IO () +overSoXSynth4G progressionHarmonizerList g ys duration x = do + let !note0 = if x /= 0.0 then closestNote (abs x) else unsafeAt notes 0 + !notes1 = map (\f -> f note0) progressionHarmonizerList + !vs = map g (note0 : notes1) + overSoXSynthHelpG j = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox")) + (soxBasicParams ys ["","-n", "test" ++ show j ++ show (i + 2) ++ ".wav", "synth", showFFloat Nothing duration "", "sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""]) "") . zip [0..] + mapM_ (\(j, vel) -> overSoXSynthHelpG j vel) . zip [0..] $ vs + mixTest2G ys + -- | Returns a pure quint lower than the given note. pureQuintNote :: Float -> Float pureQuintNote x = x / 2 ** (7 / 12) @@ -436,4 +465,3 @@ | y == 0.0 = xss | otherwise = xss ++ ["vol",showFFloat Nothing y "dB"] - diff --git a/Composition/Sound/IntermediateF.hs b/Composition/Sound/IntermediateF.hs --- a/Composition/Sound/IntermediateF.hs +++ b/Composition/Sound/IntermediateF.hs @@ -1,6 +1,6 @@ -- | -- Module : Composition.Sound.IntermediateF --- Copyright : (c) OleksandrZhabenko 2020 +-- Copyright : (c) OleksandrZhabenko 2020-2021 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com @@ -104,6 +104,7 @@ , soxREw1 , soxRE1 , soxREA1 + , soxREAS1 ) where import Numeric (showFFloat) @@ -111,7 +112,8 @@ import Control.Monad (void) import Control.Concurrent (myThreadId,forkIO,threadDelay,killThread) import qualified Data.List as L (sort) -import Control.Exception (onException) +import Control.Exception +import System.IO import Sound.Control.Exception.FinalException (FinalException (NotRecorded,ExecutableNotProperlyInstalled),catchEnd) import Data.List (isPrefixOf,isSuffixOf,(\\),maximum,minimum,partition) import GHC.Arr @@ -124,6 +126,7 @@ import System.Exit (ExitCode (ExitSuccess)) import System.Info (os) import qualified Data.Foldable as F +import System.Process.Sequential -- | Gets sizes of the \"result\*.wav\" files in the current directory. getFileRSizes :: IO (Array Int Integer) @@ -737,13 +740,44 @@ -- 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). +-- for the resulting file (in the supported by the SoX format). +-- Works well with the number of the files not exceeding several hundreds. Otherwise, can lead to resource leakage and +-- in such a case 'soxREAS1' is recommended to be used instead. 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 + mapM_ (\file -> catch (soxREw1 reverberance damping roomscale stereodepth predelay wetgain file) (\e -> do -- this for the catch is taken from the Control.Exception module from the @base@ package. + let err = show (e :: IOException) + hPutStrLn stderr ("Warning: SoX exception: " ++ err) + return ())) dir0L (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (concat [dir0L, [file, "reverb", show (abs reverb2 `rem` 101)]]) "" print herr - +-- | 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). +-- Has some complex processment (see for details: 'seqFlsReadProcessWithExitCode') and is recommended if the directory +-- contains hundreds of the input needed files. +soxREAS1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> String -> String -> FilePath -> IO () +soxREAS1 reverberance damping roomscale stereodepth predelay wetgain reverb2 ys zs file = do + dir0V <- listVDirectory3G ys zs + let dir0L = F.toList dir0V + mapM_ (\file -> catch (soxREw1 reverberance damping roomscale stereodepth predelay wetgain file) (\e -> do -- this for the catch is taken from the Control.Exception module from the @base@ package. + let err = show (e :: IOException) + hPutStrLn stderr ("Warning: SoX exception: " ++ err) + return ())) dir0L + let thesame = map fst . takeWhile (\(x,y) -> x == y) . zip (unsafeAt dir0V 0) . unsafeAt dir0V $ 1 + f rs = ks `mappend` drop (length zs) rs + where ks + | zs == "result" = "intermediate" + | isPrefixOf "intermediate" rs = "end" + | otherwise = "intermedresult" + ns = [100,80,75,90,85] + g_N = id + h_S xs _ = ["earwax"] + _ <- seqFlsReadProcessWithExitCode "sox" 2 f thesame ns g_N h_S ["reverb", show (abs reverb2 `rem` 101)] [] + return () diff --git a/algorithmic-composition-basic.cabal b/algorithmic-composition-basic.cabal --- a/algorithmic-composition-basic.cabal +++ b/algorithmic-composition-basic.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: algorithmic-composition-basic -version: 0.2.2.0 +version: 0.3.0.0 synopsis: Helps to create experimental music from a file (or its part) and a Ukrainian text. description: It can also generate a timbre for the notes. Uses SoX inside. homepage: https://hackage.haskell.org/package/algorithmic-composition-basic @@ -20,6 +20,6 @@ exposed-modules: Composition.Sound.IntermediateF, Composition.Sound.Keyboard, Composition.Sound.Functional.Basics, Composition.Sound.Functional.Params, Composition.Sound.Functional.Elements -- other-modules: other-extensions: BangPatterns - build-depends: base >=4.8 && <4.15, bytestring >= 0.10.6 && <1, process >=1.4 && <1.9, mmsyn3 >=0.1.5 && <1, directory >=1.2.7 && <1.7, mmsyn7ukr-common >=0.1.1 && <1, mmsyn2-array >=0.1.1 && <1, ukrainian-phonetics-basic-array >=0.1.2 && <1, mmsyn7l >=0.9 && <1, phonetic-languages-simplified-base >=0.2 && <1, foldable-ix >=0.2 && <1 + build-depends: base >=4.8 && <4.15, bytestring >= 0.10.6 && <1, process >=1.4 && <1.9, mmsyn3 >=0.1.5 && <1, directory >=1.2.7 && <1.7, mmsyn7ukr-common >=0.1.1 && <1, mmsyn2-array >=0.1.1 && <1, ukrainian-phonetics-basic-array >=0.1.2 && <1, mmsyn7l >=0.9 && <1, phonetic-languages-simplified-base >=0.2 && <1, foldable-ix >=0.2 && <1, process-sequential >=0.1 && <1 -- hs-source-dirs: default-language: Haskell2010