dobutokO2 0.8.2.0 → 0.9.0.0

raw patch · 6 files changed

+378/−232 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• DobutokO/Sound.hs +2/−229
• DobutokO/Sound/Executable.hs +216/−0
• DobutokO/Sound/Functional.hs +152/−0
• Main.hs +1/−1
• dobutokO2.cabal +2/−2

@@ -85,3 +85,8 @@  * Eigth version revised C. Changed the sophisticated mechanism to provide real obertones in the 'oberSoXSynth2FDN' function. Fixed issues with some zeroes in the functions. Some code improvements that give more stability. Documentation improvement.++## 0.9.0.0 -- 2020-03-13++* Ninth version. Changed the module structure to four modules. Added new functions in the DobutokO.Sound.Functional module to filter possible beats. Changed some+exports for DobutokO.Sound module.

@@ -11,12 +11,9 @@ {-# OPTIONS_GHC -threaded #-}  module DobutokO.Sound (-  -- * Basic functions for the executable-  dobutokO2-  , recAndProcess   -- * Library and executable functions   -- ** For the fixed timbre-  , oberTones+  oberTones   , oberSoXSynth   , oberSoXSynthN   -- *** For the fixed timbre with different signs for harmonics coefficients@@ -27,8 +24,6 @@   -- *** Use additional parameters   , oberSoXSynthDN   , oberSoXSynth2DN-  -- *** Use additional function as a parameter-  , oberSoXSynth2FDN    -- *** Use a file for information   , oberSoXSynthNGen   , oberSoXSynthNGen2@@ -45,6 +40,7 @@   -- *** Use a file for information   , uniqOberSoXSynthNGen   , uniqOberSoXSynthNGen3+  , uniqOberSoXSynthNGen4   -- ** Work with octaves   , octavesT   , octaveUp@@ -307,48 +303,6 @@     _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""     mapM_ removeFile paths --- | Similar to 'oberSoXSynth2DN' but instead of 'oberTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with--- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is experimental feature, so--- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the--- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'.------ Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.--- But for a lot of functions this works well.-oberSoXSynth2FDN :: (Double -> V.Vector (Double, Double)) -> Double -> Double -> String -> IO ()-oberSoXSynth2FDN f x y zs- | V.null . convertToProperUkrainian $ zs = oberSoXSynth x- | otherwise = do-    let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)-        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0-        g0    = V.fromList . nubBy (\(x1,_) (x2,_) -> x1 == x2) . sortBy (\(x1,_) (x2,_) -> compare x1 x2) . V.toList . V.map (\(noteX, amplX) ->-           if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,-             abs (amplX - (fromIntegral . truncate $ amplX)))) . f-        g k   = V.takeWhile (\w -> compare (fst w) (V.unsafeIndex notes 107) /= GT && compare (snd w) 0.001 == GT) .-                   V.imap (\i (noteY,z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k -        v0    = g note0-        v1    = if isNothing note1 then V.empty-                else g . fromJust $ note1-        oberSoXSynthHelp vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))-          ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,-            "vol", showFFloat (Just 4) amplN $ show 0] "") vec-        oberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))-          ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,-            "vol", showFFloat (Just 4) amplN $ show 0] "") vec-    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",-       showFFloat (Just 4) note0 $ show 0] ""-    if isNothing note1 then do-      oberSoXSynthHelp v0-    else do -      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",-         showFFloat (Just 4) (fromJust note1) $ show 0] ""-      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-   - -- | For the given frequency it generates a musical sound with a timbre. The main component of the sound includes the lower pure quint, -- which can be in the same octave or in the one with the number lower by one. Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.@@ -876,184 +830,3 @@   _ <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""   mapM_ removeFile paths3      --- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing--- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.-dobutokO2 :: IO ()-dobutokO2 = do-  args <- getArgs-  let arg1 = concat . take 1 $ args-      file = concat . drop 1 . take 2 $ args-  exist2 <- doesFileExist file-  case arg1 of-    "1" -> do-      [_,_,octave,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5] else [1..5])-      let octave1 = read octave::Int-          ampL = read ampLS::Double-          time3 = read time2::Double-      oberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args)-    "2" -> do-      [_,_,octave,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6] else [1..6])-      let octave1 = read octave::Int-          ampL = read ampLS::Double-          time3 = read time2::Double-      uniqOberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args) wws-    "3" -> do-      [_,_,octave,ampLS,time2,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7] else [1,2,3,4,5,7])-      let octave1 = read octave::Int-          ampL = read ampLS::Double-          time3 = read time2::Double-      oberSoXSynthNGen2 file octave1 ampL time3 (unwords . drop 2 $ args) tts-    "4" -> do-      [_,_,octave,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7] else [1..7])-      let octave1 = read octave::Int-          ampL = read ampLS::Double-          time3 = read time2::Double-      uniqOberSoXSynthNGen3 file octave1 ampL time3 (unwords . drop 2 $ args) wws tts-    "5" -> do-      [_,_,octave,ampLS,time2,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7,8,9] else [1,2,3,4,5,7,8,9])-      let octave1 = read octave::Int-          ampL = read ampLS::Double-          time3 = read time2::Double-          dAmpl = read dAmpl0::Double-      oberSoXSynthNGen3 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) tts vs-    _   -> do-      [_,_,octave,ampLS,time2,wws,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7,8,9] else [1..9])-      let octave1 = read octave::Int-          ampL = read ampLS::Double-          time3 = read time2::Double-          dAmpl = read dAmpl0::Double-      uniqOberSoXSynthNGen4 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) wws tts vs---- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing--- whether there is no \"x.wav\" file in the current directory, because it can be overwritten.-recAndProcess :: String -> Int -> IO String-recAndProcess file x-  | x == 0 = onException (readProcessWithExitCode (fromJust (showE "sox")) [file, "x.wav", "-r22050", "channels", "1"] "" >> putStrLn "" >> return "") (do-     exist <- doesFileExist "x.wav"-     if exist then removeFile "x.wav"-     else putStr ""-     putStrLn ""-     putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. "-     putStrLn "Interrupt the program and start again with the valid file. "-     putStrLn "_______________________________________________________________________"-     recAndProcess file 0)-  | 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     -     exist3 <- doesFileExist file-     if exist3 then return ""-     else 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 important sound data. The default value is 0.5 "-       putStrLn "To use the default value, you can simply press Enter."-       ctrlN <- getLine-       let addit = dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN-           noiseP = if null ctrlN then ""-                    else tail addit-       controlNoiseReduction $ '0':noiseP -       norm "_x.wav" -       if isPrefixOf "nx." file -         then putStr "" -         else renameFile "8_x.wav" file -       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)-  | x == 3 = onException (do-     putStr "Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) "-     putStrLn "should belong. The number should be better in the range [1..8]"-     octave0 <- getChar-     let octave = (read [octave0]::Int) `rem` 9-     return $ show octave ) (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)-  | x == 4 = onException (do-     putStr "Please, specify the amplitude for the generated obertones as an Int number in the range [0..99]. "-     putStrLn "The default one is 99"-     putStrLn "To use the default value, you can simply press Enter."-     amplOb0 <- getLine-     if null amplOb0 then return "1.0"-     else let amplOb = (read (take 2 . filter isDigit $ amplOb0)::Int) `rem` 100 in-          case amplOb of-            99 -> return "1.0"-            _ -> if compare (amplOb `quot` 9) 1 == LT then return $ "0.0" ++ show (amplOb + 1)-                 else return $ "0." ++ show (amplOb + 1)) (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 4)-  | x == 5 = onException (do-     putStr "Please, specify the basic duration for the generated sounds as a Double number in the range [0.1..4.0]. "-     putStrLn "The default one is 0.5"-     putStrLn "To use the default value, you can simply press Enter."-     time0 <- getLine-     if null time0 then return "0.5"-     else let time1 = (read (filter (\z -> isDigit z || z == '.') $ time0)::Double) in-          if compare time1 0.1 /= LT && compare time1 4.0 /= GT then return (showFFloat (Just 4) time1 $ show 0)-          else let mantissa = time1 - (fromIntegral . truncate $ time1)-                   ceilP    = (truncate time1::Int) `rem` 4 in-               if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0))-               else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (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 5)-  | x == 7 = onException (do-     putStrLn "Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: "-     tts <- getLine-     if null tts then return "або"-     else return tts) (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 7)-  | x == 8 = onException (do-     putStr "Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. "-     putStrLn "The number is in the range [0.1..2.0]. The default one is 1.0"-     putStrLn "To use the default value, you can simply press Enter."-     dAmpl0 <- getLine-     if null dAmpl0 then return "1.0"-     else let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') $ dAmpl0)::Double) in-          if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then return (showFFloat (Just 4) dAmpl1 $ show 0)-          else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1)-                   ceilP    = (truncate dAmpl1::Int) `rem` 2 in-               if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0))-               else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (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 8)-  | x == 9 = onException (do-     putStrLn "Please, input the Ukrainian text that will be used to define intervals to be used to produce the lower note for the given main one. "-     putStrLn "The default one is \"й\". "-     putStrLn "To use the default value, you can simply press Enter."-     vs <- getLine-     if null vs then return "й"-     else return vs) (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 9)-  | otherwise = onException (do-     putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: "-     wws <- getLine-     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 100)

@@ -0,0 +1,216 @@+-- |+-- Module      :  DobutokO.Sound.Executable+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- A program and a library to create experimental music+-- from a mono audio and a Ukrainian text.++{-# OPTIONS_GHC -threaded #-}++module DobutokO.Sound.Executable (+  -- * Basic functions for the executable+  dobutokO2+  , recAndProcess+) where++import Numeric+import Control.Exception (onException)+import System.Environment (getArgs)+import Data.List (isPrefixOf,sort,sortBy)+import Data.Maybe (isJust,isNothing,fromJust)+import Data.Char (isDigit)+import System.Process+import EndOfExe+-- import MMSyn7.Syllable +-- import MMSyn7s+import System.Directory+import SoXBasics+import Processing_mmsyn7ukr+import Melodics.Ukrainian+import DobutokO.Sound hiding (dobutokO2, recAndProcess)+-- import DobutokO.Sound.Functional ++-- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.+dobutokO2 :: IO ()+dobutokO2 = do+  args <- getArgs+  let arg1 = concat . take 1 $ args+      file = concat . drop 1 . take 2 $ args+  exist2 <- doesFileExist file+  case arg1 of+    "1" -> do+      [_,_,octave,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5] else [1..5])+      let octave1 = read octave::Int+          ampL = read ampLS::Double+          time3 = read time2::Double+      oberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args)+    "2" -> do+      [_,_,octave,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6] else [1..6])+      let octave1 = read octave::Int+          ampL = read ampLS::Double+          time3 = read time2::Double+      uniqOberSoXSynthNGen file octave1 ampL time3 (unwords . drop 2 $ args) wws+    "3" -> do+      [_,_,octave,ampLS,time2,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7] else [1,2,3,4,5,7])+      let octave1 = read octave::Int+          ampL = read ampLS::Double+          time3 = read time2::Double+      oberSoXSynthNGen2 file octave1 ampL time3 (unwords . drop 2 $ args) tts+    "4" -> do+      [_,_,octave,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7] else [1..7])+      let octave1 = read octave::Int+          ampL = read ampLS::Double+          time3 = read time2::Double+      uniqOberSoXSynthNGen3 file octave1 ampL time3 (unwords . drop 2 $ args) wws tts+    "5" -> do+      [_,_,octave,ampLS,time2,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7,8,9] else [1,2,3,4,5,7,8,9])+      let octave1 = read octave::Int+          ampL = read ampLS::Double+          time3 = read time2::Double+          dAmpl = read dAmpl0::Double+      oberSoXSynthNGen3 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) tts vs+    _   -> do+      [_,_,octave,ampLS,time2,wws,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7,8,9] else [1..9])+      let octave1 = read octave::Int+          ampL = read ampLS::Double+          time3 = read time2::Double+          dAmpl = read dAmpl0::Double+      uniqOberSoXSynthNGen4 file octave1 ampL time3 dAmpl (unwords . drop 2 $ args) wws tts vs++-- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing+-- whether there is no \"x.wav\" file in the current directory, because it can be overwritten.+recAndProcess :: String -> Int -> IO String+recAndProcess file x+  | x == 0 = onException (readProcessWithExitCode (fromJust (showE "sox")) [file, "x.wav", "-r22050", "channels", "1"] "" >> putStrLn "" >> return "") (do+     exist <- doesFileExist "x.wav"+     if exist then removeFile "x.wav"+     else putStr ""+     putStrLn ""+     putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. "+     putStrLn "Interrupt the program and start again with the valid file. "+     putStrLn "_______________________________________________________________________"+     recAndProcess file 0)+  | 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     +     exist3 <- doesFileExist file+     if exist3 then return ""+     else 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 important sound data. The default value is 0.5 "+       putStrLn "To use the default value, you can simply press Enter."+       ctrlN <- getLine+       let addit = dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN+           noiseP = if null ctrlN then ""+                    else tail addit+       controlNoiseReduction $ '0':noiseP +       norm "_x.wav" +       if isPrefixOf "nx." file +         then putStr "" +         else renameFile "8_x.wav" file +       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)+  | x == 3 = onException (do+     putStr "Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) "+     putStrLn "should belong. The number should be better in the range [1..8]"+     octave0 <- getChar+     let octave = (read [octave0]::Int) `rem` 9+     return $ show octave ) (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)+  | x == 4 = onException (do+     putStr "Please, specify the amplitude for the generated obertones as an Int number in the range [0..99]. "+     putStrLn "The default one is 99"+     putStrLn "To use the default value, you can simply press Enter."+     amplOb0 <- getLine+     if null amplOb0 then return "1.0"+     else let amplOb = (read (take 2 . filter isDigit $ amplOb0)::Int) `rem` 100 in+          case amplOb of+            99 -> return "1.0"+            _ -> if compare (amplOb `quot` 9) 1 == LT then return $ "0.0" ++ show (amplOb + 1)+                 else return $ "0." ++ show (amplOb + 1)) (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 4)+  | x == 5 = onException (do+     putStr "Please, specify the basic duration for the generated sounds as a Double number in the range [0.1..4.0]. "+     putStrLn "The default one is 0.5"+     putStrLn "To use the default value, you can simply press Enter."+     time0 <- getLine+     if null time0 then return "0.5"+     else let time1 = (read (filter (\z -> isDigit z || z == '.') $ time0)::Double) in+          if compare time1 0.1 /= LT && compare time1 4.0 /= GT then return (showFFloat (Just 4) time1 $ show 0)+          else let mantissa = time1 - (fromIntegral . truncate $ time1)+                   ceilP    = (truncate time1::Int) `rem` 4 in+               if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0))+               else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (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 5)+  | x == 7 = onException (do+     putStrLn "Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: "+     tts <- getLine+     if null tts then return "або"+     else return tts) (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 7)+  | x == 8 = onException (do+     putStr "Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. "+     putStrLn "The number is in the range [0.1..2.0]. The default one is 1.0"+     putStrLn "To use the default value, you can simply press Enter."+     dAmpl0 <- getLine+     if null dAmpl0 then return "1.0"+     else let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') $ dAmpl0)::Double) in+          if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then return (showFFloat (Just 4) dAmpl1 $ show 0)+          else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1)+                   ceilP    = (truncate dAmpl1::Int) `rem` 2 in+               if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0))+               else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (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 8)+  | x == 9 = onException (do+     putStrLn "Please, input the Ukrainian text that will be used to define intervals to be used to produce the lower note for the given main one. "+     putStrLn "The default one is \"й\". "+     putStrLn "To use the default value, you can simply press Enter."+     vs <- getLine+     if null vs then return "й"+     else return vs) (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 9)+  | otherwise = onException (do+     putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: "+     wws <- getLine+     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 100)

@@ -0,0 +1,152 @@+-- |+-- Module      :  DobutokO.Sound.Functional+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- A program and a library to create experimental music+-- from a mono audio and a Ukrainian text.++{-# OPTIONS_GHC -threaded #-}++module DobutokO.Sound.Functional (+  -- * Use additional function as a parameter+  oberSoXSynth2FDN+  , oberSoXSynth2FDN_B+  , oberSoXSynth2FDN_B2+) where++import Numeric+import Data.List (isPrefixOf,sort,sortBy,nubBy)+import Data.Maybe (isNothing,fromJust)+import qualified Data.Vector as V+import System.Process+import EndOfExe+import System.Directory+import Melodics.Ukrainian+import DobutokO.Sound hiding (oberSoXSynth2FDN)++-- | Similar to 'oberSoXSynth2DN' but instead of 'oberTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with+-- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is experimental feature, so+-- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the+-- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'.+--+-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.+-- But for a lot of functions this works well.+oberSoXSynth2FDN :: (Double -> V.Vector (Double, Double)) -> Double -> Double -> String -> IO ()+oberSoXSynth2FDN f x y zs+ | V.null . convertToProperUkrainian $ zs = oberSoXSynth x+ | otherwise = do+    let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)+        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0+        g0    = V.fromList . nubBy (\(x1,_) (x2,_) -> x1 == x2) . sortBy (\(x1,_) (x2,_) -> compare x1 x2) . V.toList . V.map (\(noteX, amplX) ->+           if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,+             abs (amplX - (fromIntegral . truncate $ amplX)))) . f+        g k   = V.takeWhile (\w -> compare (fst w) (V.unsafeIndex notes 107) /= GT && compare (snd w) 0.001 == GT) .+                   V.imap (\i (noteY,z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k +        v0    = g note0+        v1    = if isNothing note1 then V.empty+                else g . fromJust $ note1+        oberSoXSynthHelp vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))+          ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,+            "vol", showFFloat (Just 4) amplN $ show 0] "") vec+        oberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))+          ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,+            "vol", showFFloat (Just 4) amplN $ show 0] "") vec+    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",+       showFFloat (Just 4) note0 $ show 0] ""+    if isNothing note1 then do+      oberSoXSynthHelp v0+    else do +      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",+         showFFloat (Just 4) (fromJust note1) $ show 0] ""+      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++-- | Similar to 'oberSoXSynth2FDN' but you specify additional third 'Double' argument from range [0.1..10.0] that is a difference between neighbour frequencies+-- in Hz that is used to filter the frequencies that can cause beating because of close frequencies. If it is not in the range, then the function tries to+-- reposition its value to the range. +--+-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.+-- But for a lot of functions this works well.+oberSoXSynth2FDN_B :: (Double -> V.Vector (Double, Double)) -> Double -> Double -> Double -> String -> IO ()+oberSoXSynth2FDN_B f x y limB zs+ | V.null . convertToProperUkrainian $ zs = oberSoXSynth x+ | otherwise = do+    let limA0 = abs ((limB / fromIntegral 10) - (fromIntegral . truncate $ (limB / fromIntegral 10))) * fromIntegral 10+        limA  = if compare limA 0.1 == LT then 0.1 else limA+        note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)+        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0+        g0    = V.fromList . nubBy (\(x1,_) (x2,_) -> x1 == x2) . sortBy (\(x1,_) (x2,_) -> compare x1 x2) . V.toList . V.map (\(noteX, amplX) ->+           if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,+             abs (amplX - (fromIntegral . truncate $ amplX)))) . f+        g k   = V.takeWhile (\w -> compare (fst w) (V.unsafeIndex notes 107) /= GT && compare (snd w) 0.001 == GT) . V.fromList . +                   nubBy (\(x1,_) (x2,_) -> compare (abs (x1 - x2)) limA /= GT) . V.toList . V.imap (\i (noteY,z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $+                      0), z0)) . g0 $ k +        v0    = g note0+        v1    = if isNothing note1 then V.empty+                else g . fromJust $ note1+        oberSoXSynthHelp vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))+          ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,+            "vol", showFFloat (Just 4) amplN $ show 0] "") vec+        oberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))+          ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,+            "vol", showFFloat (Just 4) amplN $ show 0] "") vec+    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",+       showFFloat (Just 4) note0 $ show 0] ""+    if isNothing note1 then do+      oberSoXSynthHelp v0+    else do +      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",+         showFFloat (Just 4) (fromJust note1) $ show 0] ""+      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    +   +-- | Similar to 'oberSoXSynth2FDN_B' but the function does not try to make real obertones, so the class of functions that it can use may be broader. +--+-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.+-- But for a lot of functions this works well.+oberSoXSynth2FDN_B2 :: (Double -> V.Vector (Double, Double)) -> Double -> Double -> Double -> String -> IO ()+oberSoXSynth2FDN_B2 f x y limB zs+ | V.null . convertToProperUkrainian $ zs = oberSoXSynth x+ | otherwise = do+    let limA0 = abs ((limB / fromIntegral 10) - (fromIntegral . truncate $ (limB / fromIntegral 10))) * fromIntegral 10+        limA  = if compare limA 0.1 == LT then 0.1 else limA+        note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)+        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0+        g0    = V.fromList . nubBy (\(x1,_) (x2,_) -> x1 == x2) . sortBy (\(x1,_) (x2,_) -> compare x1 x2) . V.toList . V.map (\(noteX, amplX) ->+           if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,+             abs (amplX - (fromIntegral . truncate $ amplX)))) . f+        g k   = V.takeWhile (\w -> compare (fst w) (V.unsafeIndex notes 107) /= GT && compare (snd w) 0.001 == GT) . V.fromList . +                   nubBy (\(x1,_) (x2,_) -> compare (abs (x1 - x2)) limA /= GT) . V.toList . g0 $ k +        v0    = g note0+        v1    = if isNothing note1 then V.empty+                else g . fromJust $ note1+        oberSoXSynthHelp vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))+          ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,+            "vol", showFFloat (Just 4) amplN $ show 0] "") vec+        oberSoXSynthHelp2 vec = V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))+          ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", showFFloat (Just 4) y $ show 0,"sine", showFFloat (Just 4) noteN $ show 0,+            "vol", showFFloat (Just 4) amplN $ show 0] "") vec+    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",+       showFFloat (Just 4) note0 $ show 0] ""+    if isNothing note1 then do+      oberSoXSynthHelp v0+    else do +      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",+         showFFloat (Just 4) (fromJust note1) $ show 0] ""+      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    

@@ -10,7 +10,7 @@  module Main where -import DobutokO.Sound+import DobutokO.Sound.Executable (dobutokO2)   {-- Main function.

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dobutokO2-version:             0.8.2.0+version:             0.9.0.0 synopsis:            A program and a library to create experimental music from a mono audio and a Ukrainian text description:         It can also create a timbre for the notes homepage:            https://hackage.haskell.org/package/dobutokO2@@ -17,7 +17,7 @@ cabal-version:       >=1.10  library-  exposed-modules:     Main, DobutokO.Sound+  exposed-modules:     Main, DobutokO.Sound, DobutokO.Sound.Functional, DobutokO.Sound.Executable   -- other-modules:   -- other-extensions:   build-depends:       base >=4.7 && <4.14, vector >=0.11 && <0.14, process >=1.4 && <1.8, mmsyn3 >=0.1.4 && <1, mmsyn7s >=0.6.6 && <1, directory >=1.2.5 && <1.6, mmsyn7ukr >=0.15.3 && <1, mmsyn2 >=0.1.7 && <1, mmsyn6ukr >=0.6.3.1 && <1