packages feed

algorithmic-composition-basic (empty) → 0.1.0.0

raw patch · 24 files changed

+5697/−0 lines, 24 filesdep +basedep +bytestringdep +directorysetup-changed

Dependencies added: base, bytestring, directory, foldable-ix, mmsyn2-array, mmsyn3, mmsyn7l, mmsyn7ukr-common, phonetic-languages-simplified-base, process, ukrainian-phonetics-basic-array

Files

+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# Revision history for algorithmic-composition-basic++## 0.1.0.0 -- 2021-02-22++* First version. Released on an unsuspecting world.+Rewritten from the dobutokO2 package using arrays and lists based functionality instead of vector based one. Added some new +functions, removed some functions. +
+ Composition/Sound/DIS5G6G.hs view
@@ -0,0 +1,166 @@+-- |+-- Module      :  Composition.Sound.DIS5G6G+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.DIS5G6G (+  -- ** Auxiliary functions+  syllableStr +  -- *** Working with Intervals, Durations, Strengths and StrengthDb+  , intervalsFromString +  , vStrToVInt +  , strToInt+  , durationsAver+  , str2Durat1+  , str2Durations+  , str2Vol1+  , str2Volume+  , doublesAveragedA+  , doublesAveragedG+  , equalize2Vec+  , intervalsFromStringG+  , silentSound2G+  , strengthsAver+  , strengthsDbAver+  -- * New generalized 6G functions that works with Strengths+  , apply6G+  , apply6G2+  , apply6GS+  , apply6GS2+) where++import CaseBi.Arr (getBFstLSorted')+import Numeric+import Data.Maybe (fromJust)+import GHC.Arr+import qualified Data.Foldable as F+import System.Process+import EndOfExe+import Melodics.ByteString.Ukrainian.Arr (convertToProperUkrainianS)+import Languages.Phonetic.Ukrainian.Syllable.Arr hiding (str2Durat1)+import MMSyn7l+import Composition.Sound.IntermediateF+import Composition.Sound.Functional.Params+import Composition.Sound.Decibel++-- | Generatlized version of the 'intervalsFromString' with a possibility to specify your own 'Intervals'.+intervalsFromStringG :: Intervals -> String -> Intervals+intervalsFromStringG v = vStrToVIntG v . convertToProperUkrainianS++-- | The default way to get 'Intervals' from a converted Ukrainian text.+vStrToVInt :: String -> Intervals+vStrToVInt = (\rs -> listArray (0,length rs - 1) rs) . map (strToIntG defInt)++-- | The default way to get number of semi-tones between notes in a single element of 'Intervals'.+strToInt :: Char -> Int+strToInt = strToIntG defInt+{-# INLINE strToInt #-}++---------------------------------------------------------------------------------------------------------------------++-- | Arithmetic average for the 'Array' 'Int' is used as a weight for a duration. +doublesAveragedA :: Array Int Float -> Float -> Array Int Float+doublesAveragedA v4 y3 +  | F.null v4 || y3 == 0 || sum v4 == 0 = error "Composition.Sound.DIS5G6G.doublesAveragedA: Not defined for such arguments. "+  | otherwise = let !aver = sum v4 / fromIntegral (numElements v4) in amap (*(y3 / aver)) v4++-- | Geometric average for the 'Array' 'Int' is used as a weight for a strength. +doublesAveragedG :: Array Int Float -> Float -> Array Int Float+doublesAveragedG v4 y3 +  | F.null v4 || y3 == 0 || any (== 0) v4 = error "Composition.Sound.DIS5G6G.doublesAveragedG: Not defined for such arguments. "+  | otherwise = let !aver = product v4 ** (1.0 / (fromIntegral (numElements v4))) in amap (*(y3 / aver)) v4      ++-- | 'Durations' accounting the desired average duration.+durationsAver :: Durations -> Float -> Durations+durationsAver = doublesAveragedA++-- | 'Strengths' accounting the desired average strength.+strengthsAver :: Strengths -> Float -> Strengths+strengthsAver = doublesAveragedG++-- | 'StrengthsDb' accounting the desired average strength in dB.+strengthsDbAver :: StrengthsDb -> Float -> StrengthsDb+strengthsDbAver = doublesAveragedG++-- | Auxiliary function to make all lists in an 'Array' 'Int' equal by length (the minimum one).+equalize2Vec :: Array Int [a] -> Array Int [a]+equalize2Vec v = let min = minimum . amap length $ v in amap (take min) $ v++-- | A full conversion to the 'Durations' from a Ukrainian text. The 'String' must be not empty Ukrainian text and+-- the 'Float' must be greater than 0.0.+str2Durations :: String -> Float -> Durations+str2Durations xs y + | y > 0.0 && not (null xs) = durationsAver ((\rs -> listArray (0,length rs -1) rs) . map str2Durat1 .+    convertToProperUkrainianS $ xs) y+ | otherwise = error "Composition.Sound.DIS5G6G.str2Durations: Not defined for such arguments. "++-- | A conversion to the 'Float' that is used inside 'str2Durations'.+str2Durat1 :: Char -> Float+str2Durat1 = getBFstLSorted' (-0.153016) [('-', (-0.101995)), ('0', (-0.051020)), ('1', (-0.153016)), ('a', 0.138231), ('b', 0.057143), +  ('v', 0.082268), ('h', 0.076825), ('d', 0.072063), ('j', 0.048934), ('A', 0.055601), ('e', 0.093605), ('B', 0.070658), ('z', 0.056054), +    ('y', 0.099955), ('C', 0.057143), ('k', 0.045351), ('l', 0.064036), ('m', 0.077370), ('n', 0.074240), ('o', 0.116463), ('p', 0.134830), +      ('r', 0.049206), ('s', 0.074603), ('D', 0.074558), ('t', 0.110658), ('u', 0.109070), ('f', 0.062268), ('x', 0.077188), ('c', 0.053061), +        ('w', 0.089342), ('E', 0.057596), ('F', 0.066077), ('q', 0.020227), ('i', 0.094150), ('g', 0.062948)]++-- | A full conversion to the 'Strengths' from a Ukrainian text.+str2Volume :: String -> Strengths+str2Volume = (\rs -> listArray (0,length rs - 1) rs) . map (getBFstLSorted' 0.0 [('a', 0.890533), ('b', 0.211334), ('v', (-0.630859)), ('h', (-0.757599)), ('d', 0.884613), ('j', 0.768127), +  ('A', (-0.731262)), ('e', (-0.742523)), ('B', (-0.588959)), ('z', (-0.528870)), ('y', 0.770935), ('C', (-0.708008)), ('k', (-0.443085)), +    ('l', 0.572632), ('m', (-0.782349)), ('n', (-0.797607)), ('o', (-0.579559)), ('p', 0.124908), ('r', 0.647369), ('s', 0.155640), ('D', (-0.207764)), +      ('t', -0.304443), ('u', 0.718262), ('f', (-0.374359)), ('x', (-0.251160)), ('c', (-0.392365)), ('w', 0.381348), ('E', (-0.189240)), +        ('F', 0.251221), ('q', 0.495483), ('i', (-0.682709)), ('g', 0.557098)]) . convertToProperUkrainianS++-- | A conversion to the 'Float' that is used inside 'str2Volume'.+str2Vol1 :: String -> Float+str2Vol1 = getBFstLSorted' 0.0 [('a', 0.890533), ('b', 0.211334), ('v', (-0.630859)), ('h', (-0.757599)), ('d', 0.884613), ('j', 0.768127), +  ('A', (-0.731262)), ('e', (-0.742523)), ('B', (-0.588959)), ('z', (-0.528870)), ('y', 0.770935), ('C', (-0.708008)), ('k', (-0.443085)), +    ('l', 0.572632), ('m', (-0.782349)), ('n', (-0.797607)), ('o', (-0.579559)), ('p', 0.124908), ('r', 0.647369), ('s', 0.155640), ('D', (-0.207764)), +      ('t', -0.304443), ('u', 0.718262), ('f', (-0.374359)), ('x', (-0.251160)), ('c', (-0.392365)), ('w', 0.381348), ('E', (-0.189240)), +        ('F', 0.251221), ('q', 0.495483), ('i', (-0.682709)), ('g', 0.557098)] . head . convertToProperUkrainianS++-- | For the given non-existing 'FilePath' for a sound file supported by SoX generates a silence of the specified+-- duration and quality (see, 'soxBasicParams').+silentSound2G :: FilePath -> Float -> String -> IO ()+silentSound2G file y4 ys = do+  _ <- readProcessWithExitCode (fromJust (showE "sox")) +     ((if null ys then id else soxBasicParams ys) ["-r22040","-n",file,"synth", showFFloat (Just 1) y4 "","sine","440.0","vol","0"]) ""+  putStr ""++-- | After producing sounds as WAV or FLAC files you can apply to them volume adjustments using 'Strengths'. The first 'String' is used accordingly to +-- 'soxBasicParams' and the second one -- as a prefix of the filenames for the files that the function is applied to. The files must not be silent ones. +-- Otherwise, it leads to likely noise sounding or errors.+apply6G :: Strengths -> String -> String -> IO ()+apply6G v6 ys zs + | F.null v6 = putStrLn "Composition.Sound.DIS5G6G.apply6G: Nothing has changed, because the array of volume adjustments is empty! "+ | otherwise = do+     dir0v <- fmap elems . listVDirectory3G ys $ zs+     let !l6 = numElements v6+     mapM_ (\(i, file) -> soxE file ["norm","vol", showFFloat (Just 4) (unsafeAt v6 (i `rem` l6)) ""]) . zip [0..] $ dir0v++-- | Variant of the 'apply6G' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as a first 'String' argument. +-- It uses 'str2Volume' inside. The files must not be the silent ones. Otherwise, it leads to likely noise sounding or errors.+apply6GS :: String -> String -> String -> IO ()+apply6GS xs = apply6G (str2Volume xs)++-- | Variant of the 'apply6G' function which can be applied also to the silent files. Whether a file is silent is defined using the 'Float' argument +-- so that if the maximum by absolute value amplitude is less by absolute value than the 'Float' argument then the file is not changed.+apply6G2 :: Strengths -> String -> String -> Float -> IO ()+apply6G2 v6 ys zs limV+ | F.null v6 = putStrLn "Composition.Sound.DIS5G6G.apply6G2: Nothing has changed, because the array of volume adjustments is empty! "+ | otherwise = do+     dir0v <- fmap elems . listVDirectory3G ys $ zs+     let !l6 = numElements v6+     mapM_ (\(i, file) -> apply6GSilentFile file limV (unsafeAt v6 (i `rem` l6))) . zip [0..] $ dir0v++-- | Variant of the 'apply6G2' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as the first 'String' argument. +-- It uses 'str2Volume' inside. +apply6GS2 :: String -> String -> String -> Float -> IO ()+apply6GS2 xs = apply6G2 (str2Volume xs)+
+ Composition/Sound/Decibel.hs view
@@ -0,0 +1,55 @@+-- |+-- Module      :  Composition.Sound.Decibel+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.Decibel (+  -- * Type synonym with different semantics+  StrengthsDb+  -- * Working with StrengthsDb and Strengths and others+  , dBOmegaRatio+  , strength2dB_Abs+  , strengthdB2ampl+  , strengths2dB+  , strengthsDb2ampl+) where++import GHC.Arr+import Composition.Sound.Functional.Params (Strengths)++-- | Is used to represent a set of volumes in the dB scale for SoX \"vol\" effect. Usually, the zero value corresponds to the sound with volume +-- level equal by absolute value to 1.0 (the extremum one). So for most cases, its elements are negative numbers not less than (-120).+type StrengthsDb = Array Int Float++-- | Returns the frequency for which its ratio with the second 'Float' argument being under lg and being multiplied with 20 returns +-- the first 'Float'  argument. For example, @dBOmegaRatio 6 440 ~ 880@ (actually, 877.9154185863069).+dBOmegaRatio :: Float -> Float -> Float+dBOmegaRatio dB omega0 = omega0 * 10 ** (dB / fromIntegral 20) ++-- | Converts the absolute value of the argument to dB value compared to 1.0. Usually, is less than 0. The argument should not be equal to zero (0), +-- otherwise, it is equal to -'Infinity'.+strength2dB_Abs :: Float -> Float+strength2dB_Abs vol = 20 * logBase 10 (abs vol)++-- | Converts the absolute value of the argument from dB value to amplitude with 0 equivalent to amplitude of 1.0 (or -1.0 for inverted sound). +-- Usually, is used for negative arguments (or at least not positive ones). +strengthdB2ampl :: Float -> Float+strengthdB2ampl dB = 10 ** (dB / fromIntegral 20)++-- | Converts the 'V.Vector' of the absolute values of the argument to the 'V.Vector' of dB values compared to 1.0. +-- Usually, its elements are less than 0. If some element in the argument is equal to zero (0), the corresponding resulting element is equal to -'Infinity'.+strengths2dB :: Strengths -> StrengthsDb+strengths2dB v = amap strength2dB_Abs v++-- | Converts the 'V.Vector' of dB values to the 'V.Vector' of the amplitudes with 0 being equivalent to amplitude of 1.0 (or -1.0 for inverted sound). +-- Usually, is used for negative elements of the first argument (or at least not positive ones). +strengthsDb2ampl :: StrengthsDb -> Strengths+strengthsDb2ampl v = amap strengthdB2ampl v+
+ Composition/Sound/Executable.hs view
@@ -0,0 +1,384 @@+-- |+-- Module      :  Composition.Sound.Executable+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.++{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -threaded #-}++module Composition.Sound.Executable (+  -- * Basic functions for the executable+  dobutokO2+  , dobutokO2H7+  , dobutokO2H9+  , dobutokO2H92+  , o2help+) where++import Control.Monad (void)+import System.Exit (ExitCode (ExitSuccess))+import qualified Data.List as L (groupBy,sort)+import CaseBi.Arr (getBFstLSorted')+import Control.Exception (onException)+import System.Environment (getArgs)+import Data.List (isPrefixOf)+import Data.Maybe (fromJust,fromMaybe)+import System.Process+import EndOfExe (showE)+import GHC.Arr+import Data.Foldable.Ix (s2L)+import System.Directory+import Composition.Sound.Overtones+import Composition.Sound.Uniq+import Composition.Sound.IntermediateF +import Composition.Sound.ParseList (parseStoLInts)+import Composition.Sound.Process++-- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end*\" files in the current directory, because they can be overwritten. Since 0.44.0.0 the behaviour for \"7\" as option ('dobutokO2H7') changed. Now, it does not reduce noise.+dobutokO2 :: IO ()+dobutokO2 = do+  arggs <- getArgs+  let arg1 = concat . take 1 $ arggs+      file = concat . drop 1 . take 2 $ arggs+      args = unwords . drop 2 $ arggs+      argss = drop 1 arggs+  exist2 <- doesFileExist file+  getBFstLSorted' (dobutokO2H exist2 args file) (fmap (\(xs, f) -> (xs,f exist2 args file)) $ [("0",o2help),("00",dobutokO2H00),+    ("002",dobutokO2H002),("1",dobutokO2H1),("11",dobutokO2H11),("2",dobutokO2H2),("21",dobutokO2H21),("3",dobutokO2H3),("31",dobutokO2H31),+      ("4",dobutokO2H4),("41",dobutokO2H41),("5",dobutokO2H5),("51",dobutokO2H51),("61",dobutokO2H61),("7",dobutokO2H7),("8",dobutokO2H8),+        ("80",dobutokO2H80),("82",dobutokO2H82),("820",dobutokO2H820),("9",dobutokO2H9),("92",dobutokO2H92),("99",dobutokO2H99 argss),+          ("992",dobutokO2H992G argss),("999",dobutokO2H999 argss),("9992",dobutokO2H9992G argss)]) arg1++dobutokO2H1 :: Bool -> String -> FilePath -> IO ()+dobutokO2H1 exist2 args file = do+  [_,_,octave,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5] else [1..5])+  let (octave1,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in overSoXSynthNGen file octave1 ampL time3 args+{-# INLINE dobutokO2H1 #-}++threeStr2Val :: [String] -> Maybe (Int,Float,Float)+threeStr2Val [xs,ys,zs] = Just (read xs::Int,read ys::Float,read zs::Float)+threeStr2Val _ = Nothing+{-# INLINE threeStr2Val #-}++fourStr2Val :: [String] -> Maybe (Int,Float,Float,Float)+fourStr2Val [xs,ys,zs,tws] = Just (read xs::Int,read ys::Float,read zs::Float,read tws::Float)+fourStr2Val _ = Nothing+{-# INLINE fourStr2Val #-}++fiveStr2Val :: [String] -> Maybe ([Int],Float,Float,Float)+fiveStr2Val [xs,ys,zs,tws] = Just (map (\z -> read z::Int) . words $ xs,read ys::Float,read zs::Float,read tws::Float)+fiveStr2Val _ = Nothing+{-# INLINE fiveStr2Val #-}++dobutokO2H2 :: Bool -> String -> FilePath -> IO ()+dobutokO2H2 exist2 args file = do+  [_,_,octave,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6] else [1..6])+  let (octave1,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in uniqOverSoXSynthNGen file octave1 ampL time3 args wws+{-# INLINE dobutokO2H2 #-}++dobutokO2H3 :: Bool -> String -> FilePath -> IO ()+dobutokO2H3 exist2 args file = 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,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in overSoXSynthNGen2 file octave1 ampL time3 args tts+{-# INLINE dobutokO2H3 #-}++dobutokO2H4 :: Bool -> String -> FilePath -> IO ()+dobutokO2H4 exist2 args file = do+  [_,_,octave,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7] else [1..7])+  let (octave1,ampL,time3) = fromJust . threeStr2Val $ [octave,ampLS,time2] in uniqOverSoXSynthNGen3 file octave1 ampL time3 args wws tts+{-# INLINE dobutokO2H4 #-}++dobutokO2H5 :: Bool -> String -> FilePath -> IO ()+dobutokO2H5 exist2 args file = 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,ampL,time3,dAmpl) = fromJust . fourStr2Val $ [octave,ampLS,time2,dAmpl0] in overSoXSynthNGen3 file octave1 ampL time3 dAmpl args tts vs+{-# INLINE dobutokO2H5 #-}++dobutokO2H :: Bool -> String -> FilePath -> IO ()+dobutokO2H exist2 args file = 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,ampL,time3,dAmpl) = fromJust . fourStr2Val $ [octave,ampLS,time2,dAmpl0] in+    uniqOverSoXSynthNGen4 file octave1 ampL time3 dAmpl args wws tts vs+{-# INLINE dobutokO2H #-}++dobutokO2H61 :: Bool -> String -> FilePath -> IO ()+dobutokO2H61 exist2 args file = do+  [_,_,complexNky,ampLS,time2,wws,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,6,7,8,9] else [1,2,11,4,5,6,7,8,9])+  let ([enkA,nTh],ampL,time3,dAmpl) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,dAmpl0] in+    uniqOverSoXSynthNGen4E file nTh enkA ampL time3 dAmpl args wws tts vs+{-# INLINE dobutokO2H61 #-}++dobutokO2H8 :: Bool -> String -> FilePath -> IO ()+dobutokO2H8 exist2 args file = void (dobutokO2H8G exist2 args file)+{-# INLINE dobutokO2H8 #-}++dobutokO2H80 :: Bool -> String -> FilePath -> IO ()+dobutokO2H80 exist2 args file = dobutokO2H8G exist2 args file  >>= \case+    (ExitSuccess, path8v) -> mapM_ removeFile path8v+    _           -> return ()+{-# INLINE dobutokO2H80 #-}++dobutokO2H8G :: Bool -> String -> FilePath -> IO (ExitCode, [FilePath])+dobutokO2H8G _ _ _ = do+  path8s0 <- listDirectory "."+  let path8v = L.sort . filter (isPrefixOf "result") $ path8s0+      path8v1 = map (\i0 -> s2L (i0 * 800) 800 path8v) [0..(length path8v `quot` 800 - 1)] ++ [s2L (800 *+         (length path8v `quot` 800)) (length path8v `rem` 800) path8v]+  mapM_ dO2H8 . zip [0..] $ path8v1+  epath0s <- listDirectory "."+  let epaths = L.sort . filter (isPrefixOf "end0") $ epath0s+  (code1,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (epaths ++ ["end.wav"]) ""+  case code1 of+    ExitSuccess -> mapM_ removeFile epaths+    _           -> do+      exi1 <- doesFileExist "end.wav"+      if exi1+        then do+          removeFile "end.wav"+          error "The end file \"end.wav\" was not created. "+        else error "The end file \"end.wav\" was not created. "+  return (code1, path8v)+{-# INLINE dobutokO2H8G #-}++dobutokO2H82G :: Bool -> String -> FilePath -> IO (ExitCode, [FilePath])+dobutokO2H82G _ ys _ = do+  path8s0 <- listDirectory "."+  let path8v = L.sort . filter (isPrefixOf "result") $ path8s0+      path8v1 = map (\i0 -> s2L (i0 * 800) 800 path8v ) [0..(length path8v `quot` 800 - 1)] ++ [s2L (800 *+         (length path8v `quot` 800)) (length path8v `rem` 800) path8v] +  if drop 3 ys == "f" then mapM_ dO2H8f . zip [0..] $ path8v1 else mapM_ dO2H8 . zip [0..] $ path8v1+  epath0s <- listDirectory "."+  let epaths = L.sort . filter (isPrefixOf "end0") $ epath0s+  (code1,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (epaths ++ soxBasicParams ys ("":["end.wav"])) ""+  case code1 of+    ExitSuccess -> mapM_ removeFile epaths+    _           -> do+      exiW <- doesFileExist "end.wav"+      exiF <- doesFileExist "end.flac"+      if exiW && not (exiF)+        then do+          removeFile "end.wav"+          error "The end file \"end.wav\" was not created. "+        else+          if exiF && not (exiW) then do+            removeFile "end.flac"+            error "The end file \"end.flac\" was not created. "+          else if exiF && exiW then do+                 removeFile "end.flac"+                 removeFile "end.wav"+                 error "The end file \"end.*\" was not created. "+               else error "The end file \"end.*\" was not created. "+  return (code1, path8v)+{-# INLINE dobutokO2H82G #-}++dobutokO2H82 :: Bool -> String -> FilePath -> IO ()+dobutokO2H82 exist2 ys file = void (dobutokO2H82G exist2 ys file)+{-# INLINE dobutokO2H82 #-}++dobutokO2H820 :: Bool -> String -> FilePath -> IO ()+dobutokO2H820 exist2 ys file = dobutokO2H82G exist2 ys file  >>= \case+    (ExitSuccess, path8v) -> mapM_ removeFile path8v+    _           -> return ()+{-# INLINE dobutokO2H820 #-}++dobutokO2H11 :: Bool -> String -> FilePath -> IO ()+dobutokO2H11 exist2 args file = do+  [_,_,complexNky,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5] else [1,2,11,4,5])+  let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in overSoXSynthNGenE file nTh enkA ampL time3 args+{-# INLINE dobutokO2H11 #-}++dobutokO2H21 :: Bool -> String -> FilePath -> IO ()+dobutokO2H21 exist2 args file = do+  [_,_,complexNky,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,6] else [1,2,11,4,5,6])+  let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in uniqOverSoXSynthNGenE file nTh enkA ampL time3 args wws+{-# INLINE dobutokO2H21 #-}++dobutokO2H31 :: Bool -> String -> FilePath -> IO ()+dobutokO2H31 exist2 args file = do+  [_,_,complexNky,ampLS,time2,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,7] else [1,2,11,4,5,7])+  let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in overSoXSynthNGen2E file nTh enkA ampL time3 args tts+{-# INLINE dobutokO2H31 #-}++dobutokO2H41 :: Bool -> String -> FilePath -> IO ()+dobutokO2H41 exist2 args file = do+  [_,_,complexNky,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,6,7] else [1,2,11,4,5,6,7])+  let ([enkA,nTh],ampL,time3,_) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,""] in uniqOverSoXSynthNGen3E file nTh enkA ampL time3 args wws tts+{-# INLINE dobutokO2H41 #-}++dobutokO2H51 :: Bool -> String -> FilePath -> IO ()+dobutokO2H51 exist2 args file = do+  [_,_,complexNky,ampLS,time2,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,11,4,5,7,8,9] else [1,2,11,4,5,7,8,9])+  let ([enkA,nTh],ampL,time3,dAmpl) = fromJust . fiveStr2Val $ [complexNky,ampLS,time2,dAmpl0] in+    overSoXSynthNGen3E file nTh enkA ampL time3 dAmpl args tts vs+{-# INLINE dobutokO2H51 #-}++dO2H8 :: (Int, [String]) -> IO ()+dO2H8 (i, v) = do+  (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (v ++ ["end0" ++ show i ++ ".wav"]) ""+  case code of+    ExitSuccess -> putStr ""+    _           -> do+      exi0 <- doesFileExist $ "end0" ++ show i ++ ".wav"+      if exi0+        then do+          removeFile $ "end0" ++ show i ++ ".wav"+          error $ "The intermediate file " ++ "\"end0" ++ show i ++ ".wav\" was not created. "+        else error $ "The intermediate file " ++ "\"end0" ++ show i ++ ".wav\" was not created. "+{-# INLINE dO2H8 #-}++dO2H8f :: (Int, [String]) -> IO ()+dO2H8f (i, v) = do+  (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (v ++ ["end0" ++ show i ++ ".flac"]) ""+  case code of+    ExitSuccess -> putStr ""+    _           -> do+      exi0 <- doesFileExist $ "end0" ++ show i ++ ".flac"+      if exi0+        then do+          removeFile $ "end0" ++ show i ++ ".flac"+          error $ "The intermediate file " ++ "\"end0" ++ show i ++ ".flac\" was not created. "+        else error $ "The intermediate file " ++ "\"end0" ++ show i ++ ".flac\" was not created. "+{-# INLINE dO2H8f #-}++-- | Actually works as 'pAnR_' function.+dobutokO2H9 :: Bool -> String -> FilePath -> IO ()+dobutokO2H9 _ _ _ = pAnR_+{-# INLINE dobutokO2H9 #-}++-- | Actually works as 'pAnR_2G' function.+dobutokO2H92 :: Bool -> String -> FilePath -> IO ()+dobutokO2H92 _ ys _ = pAnR_2G ys+{-# INLINE dobutokO2H92 #-}++dobutokO2H99 :: [String] -> Bool -> String -> FilePath -> IO ()+dobutokO2H99 argss _ _ file = do+  (v1,dir0V) <- dO2H99 "221w" file+  let dir0A = (\rs -> listArray (0,length rs - 1) rs) dir0V+  mapM_ (\idx -> playE (unsafeAt dir0A idx) argss) v1+{-# INLINE dobutokO2H99 #-}++dO2H99 :: String -> FilePath -> IO ([Int],[FilePath])+dO2H99 ys file = do+  dir0V <- listVDirectory2G ys+  let l0 = length dir0V+  putStrLn $ "You have available " ++ show l0 ++ " files that can be played. The minimum index further is 0, the maximum is " ++ show (l0 - 1)+  list1 <- recAndProcess file (99::Int)+  let yss = divideToStr l0 list1+      mxE = fromMaybe (l0 - 1) (maxLinV yss)+      mnE = fromMaybe 0 (minLinV yss)+      zss = map (filterToBnds mnE mxE) yss+      v1 = doubleLtoV zss+  return (v1,dir0V)+{-# INLINE dO2H99 #-}++dobutokO2H992G :: [String] -> Bool -> String -> FilePath -> IO ()+dobutokO2H992G argss _ ys file = do+  (v1,dir0V) <- dO2H99 ys file+  let dir0A = (\rs -> listArray (0,length rs - 1) rs) dir0V+  mapM_ (\idx -> playE (unsafeAt dir0A idx) argss) v1+{-# INLINE dobutokO2H992G #-}++dobutokO2H999 :: [String] -> Bool -> String -> FilePath -> IO ()+dobutokO2H999 argss _ _ file = do+  (v1,dir0V) <- dO2H99 "221w" file+  let dir0A = (\rs -> listArray (0,length rs - 1) rs) dir0V+  mapM_ (\idx -> soxE1 (unsafeAt dir0A idx) argss) v1+{-# INLINE dobutokO2H999 #-}++dobutokO2H9992G :: [String] -> Bool -> String -> FilePath -> IO ()+dobutokO2H9992G argss _ ys file = do+  (v1,dir0V) <- dO2H99 ys file+  let dir0A = (\rs -> listArray (0,length rs - 1) rs) dir0V+  mapM_ (\idx -> soxE1 (unsafeAt dir0A idx) argss) v1+{-# INLINE dobutokO2H9992G #-}++divideToStr :: Int -> String -> [[Int]]+divideToStr n = map (parseStoLInts n). lines++isDataStr :: String -> Bool+isDataStr = notElem '@'++isTextPair :: String -> String -> Bool+isTextPair xs ys = isDataStr xs && isDataStr ys++failureNotification2 :: IO ()+failureNotification2 = do+  putStrLn "--------------------------------------------------------------------------------------------------------------------"+  putStrLn ""+  putStrLn "The operation was not successful because of the not valid textual input. Please, specify a valid textual input. "++-- | Used to obtain one multiline specially formatted textual input and do the full processment for the sound. +-- The function generates overtones using additional 'String' and allows maximum control over the parameters.+-- Besides, all the needed information it obtains from the singular formatted input, which can be ended+-- with a keyboard keys combination that means an end of input (e. g. for Unices, that is probably Ctrl + D).+-- \'@\' are separators for the input parts for their respective parts. For more information about the+-- format of the single input, see:+--+-- 'https://drive.google.com/open?id=10Z_GRZR4TKoL5KXfqPm-t-4humuHN0O4'+--+-- The file is also provided with the package as text.dat.txt. +-- The last two or three inputs (an input just here means a textual input between two \'@\') can be omitted,+-- the program will work also but with less control for the user possible. +-- +dobutokO2H7 :: Bool -> String -> FilePath -> IO ()+dobutokO2H7 True args file = do+  putStrLn "Please, specify a prepared textual input. To end the input press a keyboard keys combination that means an end of the input (e. g. for Unices, possibly Ctrl + D). "+  input <- getContents+  let text0   = lines input+      listTxt = filter isDataStr . map (unwords . words . unlines) . L.groupBy isTextPair $ text0+      l       = length listTxt+  case l of+    4 -> onException (do+      let [octave0,ampLS0,time20,wws] = listTxt+          octave1 = read (d3H octave0)::Int+          ampL = read (d4H ampLS0)::Float+          time3 = read (d5H time20)::Float+      uniqOverSoXSynthNGen file octave1 ampL time3 args wws) (failureNotification2 >> dobutokO2H7 True args file)+    5 -> onException (do+      let [octave0,ampLS0,time20,wws,tts0] = listTxt+          octave1 = read (d3H octave0)::Int+          ampL = read (d4H ampLS0)::Float+          time3 = read (d5H time20)::Float+      uniqOverSoXSynthNGen3 file octave1 ampL time3 args wws (d7H tts0)) (failureNotification2 >> dobutokO2H7 True args file)+    7 -> onException (do+      let [octave0,ampLS0,time20,wws,tts0,dAmpl0,vs0] = listTxt+          octave1 = read (d3H octave0)::Int+          ampL = read (d4H ampLS0)::Float+          time3 = read (d5H time20)::Float+          dAmpl = read (d8H dAmpl0)::Float+      uniqOverSoXSynthNGen4 file octave1 ampL time3 dAmpl args wws (d7H tts0) (d9H vs0)) (failureNotification2 >>+         dobutokO2H7 True args file)+    _ -> failureNotification2 >> dobutokO2H7 True args file+dobutokO2H7 _ args file = onException (do+  _ <- processD1+--  _ <- processD2 file   Is not used since the version after 0.43.0.0.+  dobutokO2H7 True args file) (do+    putStrLn "--------------------------------------------------------------------------------------------------------------------"+    putStrLn ""+    putStr "The operation was not successful because the file with such a name does not exist or was not created by a program. "+    putStrLn "Please, interrupt a program and start again with a better data. "+    dobutokO2H7 False args file)+{-# INLINE dobutokO2H7 #-}++-- | Takes textual input from the stdin and prints it as one 'String' to the stdout.+o2help :: Bool -> String -> FilePath -> IO ()+o2help _ _ _ = do+  xs <- getContents+  let ys = unwords . lines $ xs in do+    putStrLn ""+    putStrLn "-------------------------------------------------------------------------------------------------------------"+    putStrLn ys++dobutokO2H00 :: Bool -> String -> FilePath -> IO ()+dobutokO2H00 _ = fadeAllE+{-# INLINE dobutokO2H00 #-}++dobutokO2H002 :: Bool -> String -> FilePath -> IO ()+dobutokO2H002 _ = fadeAllEMilN 2+{-# INLINE dobutokO2H002 #-}
+ Composition/Sound/Extended.hs view
@@ -0,0 +1,65 @@+-- |+-- Module      :  Composition.Sound.Extended+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.Extended (+  -- * Even more extended+  dviykyTA+  , triykyTA+  , chetvirkyTA+  , p'yatirkyTA+  , shistkyTA+  , simkyTA+  , visimkyTA+  , dev'yatkyTA+  , desyatkyTA+  , odynadtsyatkyTA+  , octavesTA+) where++--import qualified Data.Vector as V+import GHC.Arr+import Composition.Sound.Functional.Basics (NotePairs,notes)++dviykyTA :: NotePairs+dviykyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 1))) . listArray (0,106) $ [0..106]++triykyTA :: NotePairs+triykyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 2))) . listArray (0,105) $ [0..105]++chetvirkyTA :: NotePairs+chetvirkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 3))) . listArray (0,104) $ [0..104]++p'yatirkyTA :: NotePairs+p'yatirkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 4))) . listArray (0,103) $ [0..103]++shistkyTA :: NotePairs+shistkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 5))) . listArray (0,102) $ [0..102]++simkyTA :: NotePairs+simkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 6))) . listArray (0,101) $ [0..101]++visimkyTA :: NotePairs+visimkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 7))) . listArray (0,100) $ [0..100]++dev'yatkyTA :: NotePairs+dev'yatkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 8))) . listArray (0,99) $ [0..99]++desyatkyTA :: NotePairs+desyatkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 9))) . listArray (0,98) $ [0..98]++odynadtsyatkyTA  :: NotePairs+odynadtsyatkyTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 10))) . listArray (0,97) $ [0..97]++octavesTA :: NotePairs+octavesTA = amap (\i -> (unsafeAt notes i, unsafeAt notes (i + 11))) . listArray (0,96) $ [0..96]++--------------------------------------------------------------------------------------------------------------------------
+ Composition/Sound/FunctionF.hs view
@@ -0,0 +1,80 @@+-- |+-- Module      :  Composition.Sound.FunctionF+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.FunctionF (+  -- * Working with OvertonesO and function f+  maybeFFromStrVec+  , fVecCoefs+  , showFFromStrVec+) where++import Text.Read (readMaybe)+import Data.Maybe (isNothing,fromJust,fromMaybe)+import Numeric+import GHC.Arr+import qualified Data.Foldable as F+import Composition.Sound.Functional.Basics++-- | Gets a function @f::Float -> OvertonesO@ that can be used further. Has two variants with usage of 'closestNote' ('Int' argument is greater than 0)v+--  and without it ('Int' argument is less than 0). For both cases 'String' must be in a form list of tuples of pairs of 'Float' to get somewhat+-- reasonable result. The function @f@ can be shown using a special printing function 'showFFromStrVec'. It is a simplest multiplicative (somewhat+-- acoustically and musically reasonable) form for the function that can provide such a result that fits into the given data.+--+-- > let (y,f1) = fromJust (maybeFFromStrVec 1 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783)+-- >+-- > (3520.0,[(25.829079975681818,0.2486356),(37.936206670369316,0.6464867),(494.9891484317899,0.374618646),(803.9138234326421,0.463486461)])+-- >+-- > let (y,f1) = fromJust (maybeFFromStrVec (-1) 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783)+-- > +-- > (3583.9783,[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)])+-- +maybeFFromStrVec :: Int -> Float -> String -> Maybe (Float,(Float -> [(Float,Float)]))+maybeFFromStrVec n x ys+  | n == 0 || null ys = Nothing+  | n > 0 = +     let y = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+         v = readMaybe ys::Maybe ([(Float,Float)])+         v2 = fromMaybe [] v+         v30 = map (\(t,_) -> t / y) $ v2 in+           if F.null v30 then Nothing+           else let v3 = (\rs -> listArray (0,length rs -1) rs) v30 in Just (y,(\t1 -> map (\(i, (_,ampl2)) -> ((unsafeAt v3 i) * t1,ampl2)) . zip [0..] $ v2))+  | otherwise = +     let y = (if x /= 0.0 then abs x else unsafeAt notes 0)+         v = readMaybe ys::Maybe ([(Float,Float)])+         v2 = fromMaybe [] v+         v30 = map (\(t,_) -> t / y) v2 in+           if F.null v30 then Nothing+           else let v3 = (\rs -> listArray (0,length rs -1) rs) v30 in Just (y,(\t1 -> map (\(i, (_,ampl2)) -> ((unsafeAt v3 i) * t1,ampl2)) . zip [0..] $ v2))++-- | Gets multiplication coefficients for @f::Float -> [(Float,Float)]@ from the 'maybeFFromStrVec' with the same arguments.+fVecCoefs :: Int -> Float -> String -> [Float]+fVecCoefs n x ys =+  let rs = maybeFFromStrVec n x ys in+    case rs of+      Nothing -> []+      _       -> let (_,f1) = fromJust rs in map fst (f1 1)++-- | Experimental 'show' for @f::Float -> [(Float,Float)]@ that is used only for visualisation. It is correct only with 'maybeFFromStrVec' or+-- equivalent function. Because the shape of the @f@ is known the function can be defined.+-- +-- > showFFromStrVec (-1) 440 "[(25.358,0.3598),(489.35,0.4588962),(795.35,0.6853)]"+-- > +-- > "(440.00,(\t -> [(0.05763181818181818 * t, 0.3598),(1.112159090909091 * t, 0.4588962),(1.8076136363636364 * t, 0.6853)]))"+-- +showFFromStrVec :: Int -> Float -> String -> String+showFFromStrVec n x ys+ | isNothing . maybeFFromStrVec n x $ ys = ""+ | otherwise =+    let (y,f) = fromJust . maybeFFromStrVec n x $ ys+        l = length ("(" ++ (showFFloat Nothing y "") ++ ",(\t -> [(" ++ concatMap (\z -> (showFFloat Nothing (fst z) $+          " * t, " ++ (showFFloat Nothing (snd z) "),("))) (f 1)) in+            take (l - 2) ("(" ++ (showFFloat Nothing y "") ++ ",(\t -> [(" ++ concatMap (\z -> (showFFloat Nothing (fst z) " * t, " ++ (showFFloat Nothing (snd z) "),("))) (f 1)) ++ "]))"
+ Composition/Sound/Functional.hs view
@@ -0,0 +1,529 @@+-- |+-- Module      :  Composition.Sound.Functional+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.++{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -threaded #-}++module Composition.Sound.Functional (+  -- * Use additional function as a parameter+  overSoXSynth2FDN+  , overSoXSynth2FDN_B+  -- ** Just simple function application+  -- *** With additional filtering+  -- * Use additional function and Ukrainian texts and generates melody+  , overSoXSynthGen2FDN+  , overSoXSynthGen2FDN_B+  -- * 1G generalized functions with dB volume overtones adjustments+  , overSoXSynth2FDN1G+  , overSoXSynth2FDN_B1G+  , overSoXSynth2FDN_S1G+  , overSoXSynth2FDN_Sf1G+  , overSoXSynth2FDN_Sf31G+  -- * 2G generalized functions with additional sound quality specifying+  , overSoXSynth2FDN2G+  , overSoXSynth2FDN_B2G+  , overSoXSynth2FDN_S2G+  , overSoXSynth2FDN_Sf2G+  , overSoXSynth2FDN_Sf32G+  -- ** 2G generalized functions for melody producing+  , overSoXSynthGen2FDN_SG2G+  , overSoXSynthGen2FDN_Sf3G2G+  -- * Generalized functions with several functional parameters+  , overSoXSynthGen2FDN_SG+  , overSoXSynthGen2FDN_Sf3G+  -- ** 1G generalized function with db volume overtones adjustments and several functional parameters+  , soundGenF31G+  -- * New functions for the version 0.36.0.0+  , overSoXSynthGen2FDN4G+  , overSoXSynthGen2FDN_SG4G+  , overSoXSynthGen2FDN_SG4GS+  -- * New generalized 5G functions that works with Intervals+  , overSoXSynth2FDN5G+  , overSoXSynth2FDN_B5G+  , overSoXSynth2FDN_S5G+  , overSoXSynth2FDN_Sf35G+  -- * New generalized 6G functions that works with Strengths+  , overSoXSynth2FDN6G+  , overSoXSynth2FDN6GS+  , overSoXSynth2FDN_B6G+  , overSoXSynth2FDN_B6GS+  , overSoXSynth2FDN_S6G+  , overSoXSynth2FDN_S6GS+  , overSoXSynth2FDN_Sf36G+  , overSoXSynth2FDN_Sf36GS+  , overSoXSynthGen2FDN_SG6G+  , overSoXSynthGen2FDN_SG6GS+  , overSoXSynthGen2FDN_SG6GSu+  -- * Auxiliar functions+  , help11+  , help12+  , help13+) where++import Numeric+import Data.List (nubBy)+import Data.Maybe (isNothing,fromJust,fromMaybe,maybe)+import GHC.Arr+import qualified Data.Foldable as F+import System.Process+import EndOfExe+import System.Directory+import Melodics.ByteString.Ukrainian.Arr (convertToProperUkrainianS)+import Composition.Sound.IntermediateF+import Composition.Sound.Functional.Basics+import Composition.Sound.Functional.Params+import Composition.Sound.DIS5G6G (intervalsFromStringG,str2Durations,str2Vol1,str2Volume)++-- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Float -> [(Float, Float)]@ with+-- somewhat sophisticated mechanism to normalize the resulting list elements @(Float, Float)@. The last one is an 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+-- 'convertToProperUkrainianS' to the 'String' parameter must not be []. 'Int' argument is an index of the element to be taken from +-- the 'intervalsFromString' applied to the 'String' argument. To obtain compatible with versions prior to 0.20.0.0 behaviour, use for the 'Int' 0.+--+-- 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.+-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN'.+overSoXSynth2FDN :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()+overSoXSynth2FDN f (x, y) j zs = overSoXSynth2FDN1G f (x, y) j zs ((\rs -> listArray (0, l - 1) rs) . replicate l $ 0.0)+     where !l = length . f . closestNote $ if x /= 0.0 then abs x else unsafeAt notes 0+{-# INLINE overSoXSynth2FDN #-}++-- | 'Array' 'Int' of 'Float' is a vector of dB volume adjustments for the corresponding harmonices (overtones).+overSoXSynth2FDN1G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> Array Int Float -> IO ()+overSoXSynth2FDN1G f (x, y) j zs vdB = overSoXSynth2FDN2G f (x, y) j zs vdB []+{-# INLINE overSoXSynth2FDN1G #-}+ +-- | Similar to 'overSoXSynth2FDN1G', but additionally allows to specify by the second 'String' argument a quality changes to the generated files+-- (please, see 'soxBasicParams'). Since version 0.36.0.0 the function supports generation of the pauses.+overSoXSynth2FDN2G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> Array Int Float -> String -> IO ()+overSoXSynth2FDN2G f (x, y) j zs vdB ys+ | null . convertToProperUkrainianS $ zs = overSoXSynthG f x+ | otherwise = do+    let note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        l0 = length zs+        note1 = dNote (unsafeAt (intervalsFromString zs) (abs (j `rem` l0))) note0+    help11 f (x, y) j vdB ys l0 note1 note0++-- | Similar to 'overSoXSynth2FDN2G', but additionally allows to specify by the 'Intervals' argument to specify your own intervals. For more information, +-- please, refer to 'intervalsFromStringG'.+overSoXSynth2FDN5G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Intervals -> Array Int Float -> String -> IO ()+overSoXSynth2FDN5G f (x, y) j v5 vdB ys+ | F.null v5 = overSoXSynthG f x+ | otherwise = do+    let note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        l0 = numElements v5+        note1 = dNote (unsafeAt v5 (abs (j `rem` l0))) note0+    help11 f (x, y) j vdB ys l0 note1 note0++help11 :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Array Int Float -> String -> Int -> Maybe Float -> Float -> IO ()+help11 f (x, y) j vdB ys l0 note1 note0 = do+  let g0    = nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . map (\(noteX, !amplX) ->+           if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,+             abs (amplX - (fromIntegral . truncate $ amplX)))) . f+      g k   = takeWhile (\(!w,!z) -> w <= unsafeAt notes 107 && abs z > 0.001) .+                   map (\(i, (_,!z0)) -> (fromIntegral (i + 1) * (fst . head . g0 $ k), z0)) . zip [0..] . g0 $ k +      v0    = g note0+      v1    = maybe [] g note1+      ts = showFFloat (Just 4) (abs y) "" +      overSoXSynthHelp = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+          ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", +              showFFloat Nothing noteN "", "vol", if y > 0.0 then showFFloat Nothing amplN "" else "0"]) "") . zip [0..]+      overSoXSynthHelp2 vec vdB = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+          ((if null ys then id else soxBasicParams ys) (adjust_dbVol ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", +            showFFloat Nothing noteN "","vol", if y > 0.0 then showFFloat Nothing amplN "" else "0"] (unsafeAt vdB i))) "") . zip [0..] $ vec+  _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts, +       "sine", showFFloat Nothing note0 "","vol", if y > 0.0 then "1.0" else "0"]) ""+  if isNothing note1 then overSoXSynthHelp v0+  else do +    _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts, +       "sine",  showFFloat Nothing (fromJust note1) "","vol", if y > 0.0 then "1.0" else "0"]) ""+    overSoXSynthHelp v0+    overSoXSynthHelp2 v1 vdB+  if null ys then mixTest else mixTest2G ys+{-# INLINE help11 #-}  ++-- | Generalized variant of the 'overSoXSynth2FDN5G' with afterwards 'apply6Gf' usage. +overSoXSynth2FDN6G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Intervals -> Array Int Float -> String -> Float -> IO ()+overSoXSynth2FDN6G f (x, y) j v5 vdB ys vol+ | F.null v5 = overSoXSynthG f x+ | otherwise = do+    let note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        l0     = numElements v5+        note1 = dNote (unsafeAt v5 (abs (j `rem` l0))) note0+    help11 f (x, y) j vdB ys l0 note1 note0+    if y > 0.0 then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr ""++-- | A variant of the 'overSoXSynth2FDN6G' where volume adjustment is obtained from a Ukrainian text.+overSoXSynth2FDN6GS :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Intervals -> String -> Array Int Float -> String -> String -> IO ()+overSoXSynth2FDN6GS f (x, y) j v5 xs vdB ys xxs + | null . convertToProperUkrainianS $ xxs = putStrLn "Composition.Sound.Functional.overSoXSynth2FDN6GS: You provided no information to obtain volume adjustment! "+ | otherwise = overSoXSynth2FDN6G f (x, y) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs)+{-# INLINE overSoXSynth2FDN6GS #-} + +-- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set+-- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12.+-- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. A 'Float' parameter is a+-- basic sound duration, it defines tempo of the melody in general.+overSoXSynthGen2FDN :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> IO ()+overSoXSynthGen2FDN file m ku f y zs wws = overSoXSynthGen2FDN_SG file m ku f y zs wws overSoXSynth2FDN+{-# INLINE overSoXSynthGen2FDN #-}++-- | Generalized variant of the 'overSoXSynthGen2FDN' with your own specified 'Durations' for the sounds and pauses. +-- Instead of using a Ukrainian text to specify a durations for the sounds (and a rhythm +-- respectively) you provide your own rhythm as 'Durations'. Positive values correspond to durations of the sounds generated +-- and negative values -- to durations of the pauses respectively. +overSoXSynthGen2FDN4G :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Durations -> String -> IO ()+overSoXSynthGen2FDN4G file m ku f v2 wws = overSoXSynthGen2FDN_SG4G file m ku f v2 wws overSoXSynth2FDN+{-# INLINE overSoXSynthGen2FDN4G #-}++-- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Float -> [(Float, Float)]@ with+-- somewhat sophisticated mechanism to normalize the resulting list elements @(Float, Float)@. 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+-- 'convertToProperUkrainianS' to the 'String' parameter must not be []. The function also tries to perform filtering to avoid possible beating.+-- The third 'Float' parameter in the tuple is used as a limit for frequencies difference in Hz to be filtered out from the resulting sound. It is+-- considered to be from the range @[0.1..10.0]@. An 'Int' parameter is used to define the needed interval. To obtain compatible with versions prior+-- to 0.20.0.0 behaviour, use for the 'Int' 0.+--+-- 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.+-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_B'.+overSoXSynth2FDN_B :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> IO ()+overSoXSynth2FDN_B f (x, y, limB) j zs = overSoXSynth2FDN_B1G f (x, y, limB) j zs ((\rs -> listArray (0,l - 1) rs) . replicate l $ 0.0)+  where !l = length . f . closestNote $ if x /= 0.0 then abs x else unsafeAt notes 0+{-# INLINE overSoXSynth2FDN_B #-}  ++-- | 'Array' 'Int' of 'Float' is a vector of dB volume adjustments for the corresponding harmonices (overtones).+overSoXSynth2FDN_B1G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> Array Int Float -> IO ()+overSoXSynth2FDN_B1G f (x, y, limB) j zs vdB = overSoXSynth2FDN_B2G f (x, y, limB) j zs vdB []+{-# INLINE overSoXSynth2FDN_B1G #-}++-- | Generalized version of the 'overSoXSynth2FDN_B1G' with a possibility to specify sound quality parameters using additional second 'String'+-- argument. For more information, please, refer to 'soxBasicParams'. +overSoXSynth2FDN_B2G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> Array Int Float -> String -> IO ()+overSoXSynth2FDN_B2G f (x, y, limB) j zs vdB ys+ | null . convertToProperUkrainianS $ zs = overSoXSynthG f x+ | otherwise = do+    let l0    = length zs+        note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        note1 = dNote (unsafeAt (intervalsFromString zs) (abs (j `rem` l0))) note0+    help12 f (x, y, limB) j vdB ys l0 note1 note0++-- | Generalized version of the 'overSoXSynth2FDN_B2G' with a possibility to specify your own 'Intervals'. For more information, please, +-- refer to 'intervalsFromStringG'.+overSoXSynth2FDN_B5G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> Array Int Float -> String -> IO ()+overSoXSynth2FDN_B5G f (x, y, limB) j v5 vdB ys+ | F.null v5 = overSoXSynthG f x+ | otherwise = do+    let l0    = numElements v5+        note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        note1 = dNote (unsafeAt v5 (abs (j `rem` l0))) note0+    help12 f (x, y, limB) j vdB ys l0 note1 note0+    +help12 :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Array Int Float -> String -> Int -> Maybe Float -> Float -> IO ()+help12 f (x, y, limB) j vdB ys l0 note1 note0 = do+    let limA0 = abs ((limB / 10) - (fromIntegral . truncate $ (limB / 10))) * 10+        limA  = if limA0 < 0.1 then 0.1 else limA0+        g0    = nubBy (\(!x1,_) (!x2,_) -> abs (x1 - x2) < limA) . map (\(noteX, !amplX) ->+           if noteX <= 0.0 then (2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,+             abs (amplX - (fromIntegral . truncate $ amplX)))) . f+        v0    = takeWhile (\(!w,!z) -> w <= unsafeAt notes 107 && abs z > 0.001) .+                   map (\(i, (_,!z0)) -> (fromIntegral (i + 1) * (fst . head . g0 $ note0), z0)) . zip [0..] . g0 $ note0 +        v1    = if isNothing note1 then []+                else takeWhile (\(!w,!z) -> w <= unsafeAt notes 107 && abs z > 0.001) .+                   map (\(i, (_,!z0)) -> (fromIntegral (i + 1) * (fst . head . g0 . fromJust $ note1), z0)) . zip [0..] .+                     g0 . fromJust $ note1+        ts = showFFloat (Just 4) (abs y) "" +        overSoXSynthHelp = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+            ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", +              showFFloat Nothing noteN "", "vol", if y > 0.0 then showFFloat Nothing amplN "" else "0"]) "") . zip [0..]+        overSoXSynthHelp2 vec vdB = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+            ((if null ys then id else soxBasicParams ys) ((if F.null vdB then id else (\wwws -> adjust_dbVol wwws (unsafeAt vdB i))) +              ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat Nothing noteN "", "vol", +                if y > 0.0 then showFFloat Nothing amplN "" else "0"])) "") . zip [0..] $ vec+    _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",+       showFFloat Nothing note0 "","vol", if y > 0.0 then "1.0" else "0"]) ""+    if isNothing note1 then overSoXSynthHelp v0+    else do +      _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine",+         showFFloat Nothing (fromJust note1) "","vol", if y > 0.0 then "1.0" else "0"]) ""+      overSoXSynthHelp v0+      overSoXSynthHelp2 v1 vdB+    if null ys then mixTest else mixTest2G ys    +{-# INLINE help12 #-}++-- | Generalized variant of the 'overSoXSynth2FDN_B5G' with afterwards 'apply6G' usage. +overSoXSynth2FDN_B6G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> Array Int Float -> String -> Float -> IO ()+overSoXSynth2FDN_B6G f (x, y, limB) j v5 vdB ys vol +  | F.null v5 = overSoXSynthG f x+  | otherwise = do+    let l0    = numElements v5+        note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        note1 = dNote (unsafeAt v5 (abs (j `rem` l0))) note0+    help12 f (x, y, limB) j vdB ys l0 note1 note0+    if y > 0.0 then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr "" -- The line which differs for this function and the 'overSoXSynth2FDN_B5G'.++-- | A variant of the 'overSoXSynth2FDN_B6G' where volume adjustment is obtained from a Ukrainian text.+overSoXSynth2FDN_B6GS :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> String -> Array Int Float -> String -> String -> IO ()+overSoXSynth2FDN_B6GS f (x, y, limB) j v5 xs vdB ys xxs+ | null . convertToProperUkrainianS $ xxs = putStrLn "Composition.Sound.Functional.overSoXSynth2FDN_B6GS: You provided no information to obtain volume adjustment! "+ | otherwise = overSoXSynth2FDN_B6G f (x, y, limB) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs)+{-# INLINE overSoXSynth2FDN_B6GS #-} ++-- | Uses additional 'Int' parameters. The first one is a number of enka (see 'nkyT'). The second one defines, to which n-th elements set+-- (see 'nkyT') belongs the obtained higher notes in the intervals. To obtain reasonable results, please, use for the first one 2, 3, 4, 6, 9, or 12.+-- The first 'String' parameter is used to produce durations of the notes. The second one is used to define intervals. The first 'Float' parameter is a+-- basic sound duration, it defines tempo of the melody in general. The second one is a limit for frequencies difference in Hz to be filtered out from the+-- resulting sound. It is considered to be from the range @[0.1..10.0]@.+overSoXSynthGen2FDN_B :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> Float -> String -> String -> IO ()+overSoXSynthGen2FDN_B file m ku f y limB zs wws = overSoXSynthGen2FDN_Sf3G file m ku f y limB zs wws overSoXSynth2FDN_B+{-# INLINE overSoXSynthGen2FDN_B #-}++-- | Similar to 'overSoXSynth2FDN'  with the additional volume adjustment in dB for overtones given by 'Array' 'Int' of 'Float', but it does not make any normalizing transformations. To be used properly, it is needed+-- that every second element in the tuple in the list argument must be in the range [-1.0..1.0] and every first element must be in between+-- 16.351597831287414 and 7902.132820097988 (Hz). An 'Int' parameter is used to define an interval. To obtain compatible with versions prior to+-- 0.20.0.0 behaviour, use for the 'Int' 0.+--+-- 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.+-- +-- It is recommended to fully simplify the computation for \"f\" function before using it in the 'overSoXSynth2FDN_S'.+overSoXSynth2FDN_S1G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> Array Int Float -> IO ()+overSoXSynth2FDN_S1G f (x, y) j zs vdB = overSoXSynth2FDN_S2G f (x, y) j zs vdB []+{-# INLINE overSoXSynth2FDN_S1G #-}+ +-- | Generalized version of the 'overSoXSynth2FDN_S1G' with a possibility to specify sound quality parameters using the second 'String' argument.+-- For more information, please, refer to 'soxBasicParams'.+overSoXSynth2FDN_S2G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> Array Int Float -> String -> IO ()+overSoXSynth2FDN_S2G f (x, y) j zs vdB ys+ | null . convertToProperUkrainianS $ zs = overSoXSynthG f x+ | otherwise = do+    let note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        l0    = length zs+        note1 = dNote (unsafeAt (intervalsFromString zs) (abs (j `rem` l0))) note0+    help13 f (x, y) j vdB ys l0 note1 note0+    +help13 :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Array Int Float -> String -> Int -> Maybe Float -> Float -> IO ()+help13 f (x, y) j vdB ys l0 note1 note0 = do+    let v0    = f note0+        v1    = maybe [] f note1+        ts = showFFloat (Just 4) (abs y) ""+    _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",+       showFFloat Nothing note0 "","vol", if y > 0.0 then "1.0" else "0"]) ""+    if isNothing note1 then partialTest_k2G v0 0 ts vdB ys+    else do +      _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testB.wav", "synth", ts,"sine",+         showFFloat Nothing (fromJust note1) "","vol", if y > 0.0 then "1.0" else "0"]) ""+      partialTest_k2G v0 0 ts vdB ys+      partialTest_k2G v1 1 ts vdB ys+    if null ys then mixTest else mixTest2G ys   +        +-- | Generalized version of the 'overSoXSynth2FDN_S2G' where you specify your own 'Intervals'. For more information, please, refer +-- to 'intervalsFromStringG'.+overSoXSynth2FDN_S5G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Intervals -> Array Int Float -> String -> IO ()+overSoXSynth2FDN_S5G f (x, y) j v5 vdB ys+ | F.null v5 = overSoXSynthG f x+ | otherwise = do+    let note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        l0    = numElements v5+        note1 = dNote (unsafeAt v5 (abs (j `rem` l0))) note0+    help13 f (x, y) j vdB ys l0 note1 note0   ++-- | Generalized variant of the 'overSoXSynth2FDN_S5G' with afterwards 'apply6G' usage. Arguments for the latter is the three last function arguments.+overSoXSynth2FDN_S6G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Intervals -> Array Int Float -> String -> Float -> IO ()+overSoXSynth2FDN_S6G f (x, y) j v5 vdB ys vol+ | F.null v5 = overSoXSynthG f x+ | otherwise = do+    let note0 = closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)+        l0    = numElements v5+        note1 = dNote (unsafeAt v5 (abs (j `rem` l0))) note0+    help13 f (x, y) j vdB ys l0 note1 note0+    if y > 0.0 then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr ""+  +-- | A variant of the 'overSoXSynth2FDN_S6G' where volume adjustment is obtained from a Ukrainian text.+overSoXSynth2FDN_S6GS :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Intervals -> String -> Array Int Float -> String -> String -> IO ()+overSoXSynth2FDN_S6GS f (x, y) j v5 xs vdB ys xxs+ | null . convertToProperUkrainianS $ xxs = putStrLn "Composition.Sound.Functional.overSoXSynth2FDN_S6GS: You provided no information to obtain volume adjustment! "+ | otherwise = overSoXSynth2FDN_S6G f (x, y) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs)+{-# INLINE overSoXSynth2FDN_S6GS #-}++-- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. Note that the first 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthGen2FDN_SG :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> IO ()+overSoXSynthGen2FDN_SG file m ku f y zs wws h = do+  n <- duration1000 file+  overSoXSynthGen2FDN_SG4G file m ku f (str2DurationsDef n zs y) wws h+{-# INLINE overSoXSynthGen2FDN_SG #-}  ++-- | Generalized version of the 'overSoXSynthGen2FDN_SG' where instead of using a Ukrainian text to specify a durations for the sounds (and a rhythm +-- respectively) you provide your own rhythm as 'Durations'. Positive values correspond to durations of the sounds generated +-- and negative values -- to durations of the pauses respectively. Please, use a function @h :: ((Float -> OvertonesO) -> (Float, Float) -> +-- Int -> String -> IO ())@ such that it can create for the given values accorgingly sounds and pauses. Otherwise, please, check whether at +-- least it can deal with such arguments without errors. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthGen2FDN_SG4G :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Durations -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> IO ()+overSoXSynthGen2FDN_SG4G file m ku f v2 wws h = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+      zeroN = numVZeroesPre vecB+      !l = numElements v2 in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt v2 (j `rem` l))) j wws+        renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") . zip [0..] $ vecB+  endFromResult  ++-- | A variant of the 'overSoXSynthGen2FDN_SG4G' where instead of providing your own durations as 'Durations' you use a Ukrainian text and +-- a function treats each symbol in it as a duration parameter with its sign. Positive values correspond to durations of the sounds generated +-- and negative values -- to durations of the pauses respectively. Please, use a function @h :: ((Float -> OvertonesO) -> (Float, Float) -> +-- Int -> String -> IO ())@ such that it can create for the given values accorgingly sounds and pauses. Otherwise, please, check whether at +-- least it can deal with such arguments without errors.+overSoXSynthGen2FDN_SG4GS :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> IO ()+overSoXSynthGen2FDN_SG4GS file m ku f y zs = overSoXSynthGen2FDN_SG4G file m ku f (str2Durations zs y)+{-# INLINE overSoXSynthGen2FDN_SG4GS #-}++-- | 6G generalized variant of the 'overSoXSynthGen2FDN_SG4G' with volume adjustments given by 'Strengths'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthGen2FDN_SG6G :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Durations -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> Strengths -> Float -> IO ()+overSoXSynthGen2FDN_SG6G file m ku f v2 wws h v6 limV+ | F.null v6 = putStrLn "Composition.Sound.Functional.overSoXSynthGen2FDN_SG6G: You did not provide a volume adjustments array! "+ | otherwise = do+    n <- duration1000 file+    vecA <- freqsFromFile file n+    let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+        zeroN = numVZeroesPre vecB+        !l2 = numElements v2+        !l6 = numElements v6 in mapM_ (\(j, x) -> do+          h f (x, (unsafeAt v2 (j `rem` l2))) j wws+          renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav"+          apply6GSilentFile ("result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") limV (unsafeAt v6 (j `rem` l6))) .+            zip [0..] $ vecB+    endFromResult  ++-- | A variant of the 'overSoXSynthGen2FDN_SG6G' where 'Strengths' are obtained from a Ukrainian text and 'str2Volume'.+overSoXSynthGen2FDN_SG6GS :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> String -> Float -> IO ()+overSoXSynthGen2FDN_SG6GS file m ku f y zs wws h zzs = overSoXSynthGen2FDN_SG6G file m ku f (str2Durations zs y) wws h (str2Volume zzs)+{-# INLINE overSoXSynthGen2FDN_SG6GS #-}++-- | A variant of the 'overSoXSynthGen2FDN_SG6GS' where 'Strengths' are obtained from the same Ukrainian text as also 'Durations' so the last +-- 'String' argument is omitted (it is equal to the first one). Helps to create a speech-like composition.+overSoXSynthGen2FDN_SG6GSu :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> Float -> IO ()+overSoXSynthGen2FDN_SG6GSu file m ku f y zs wws h = overSoXSynthGen2FDN_SG6G file m ku f (str2Durations zs y) wws h (str2Volume zs)+{-# INLINE overSoXSynthGen2FDN_SG6GSu #-}++-- | Generalized variant of the 'overSoXSynthGen2FDN_SG' with a possibility to specify with the third 'String' argument sound quality parameters.+-- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. +-- For more information, please, refer to 'soxBasicParams'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthGen2FDN_SG2G :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> ((Float -> OvertonesO) ->+  (Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO ()+overSoXSynthGen2FDN_SG2G file m ku f y zs wws h ys = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+      zeroN = numVZeroesPre vecB+      v2    = str2DurationsDef n zs y+      !l2 = n in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt v2 (j `rem` l2))) j wws ys+        renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) +++          if drop 3 ys == "f" then ".flac" else ".wav") . zip [0..] $ vecB+  endFromResult2G ys  ++-- | Generalized variant of the 'overSoXSynth2FDN_Sf' with a possibility to adjust volume using 'adjust_dbVol'. 'Array' 'Int' of 'Float' is+-- used to specify adjustments in dB. For more information, please, refer to 'adjust_dbVol'.+overSoXSynth2FDN_Sf1G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> Array Int Float -> IO ()+overSoXSynth2FDN_Sf1G f (x, y) = overSoXSynth2FDN_Sf31G f (x, y, 0.001)+{-# INLINE overSoXSynth2FDN_Sf1G #-}++-- | Generalized variant of the 'overSoXSynth2FDN_Sf1G' with a possibility to specify sound quality using the second 'String' argument.+-- For more information, please, refer to 'soxBasicParams'.+overSoXSynth2FDN_Sf2G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> Array Int Float -> String -> IO ()+overSoXSynth2FDN_Sf2G f (x, y) = overSoXSynth2FDN_Sf32G f (x, y, 0.001)+{-# INLINE overSoXSynth2FDN_Sf2G #-}++-- | Generalized variant of the 'overSoXSynth2FDN_Sf3' function with a possibility to adjust volume using 'adjust_dBVol'. 'Array' 'Int' of 'Float'+-- specifies the needed adjustments in dB.+overSoXSynth2FDN_Sf31G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> Array Int Float -> IO ()+overSoXSynth2FDN_Sf31G f (x, y, t0) j zs vdB = overSoXSynth2FDN_Sf32G f (x, y, t0) j zs vdB []+{-# INLINE overSoXSynth2FDN_Sf31G #-}++-- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter.+-- For more information, please, refer to 'soxBasicParams'.+overSoXSynth2FDN_Sf35G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> Array Int Float -> String -> IO ()+overSoXSynth2FDN_Sf35G f (x, y, t0) j v5 vdB ys+ | F.null v5 = overSoXSynthG f x+ | otherwise = do+    let !l0 = numElements v5+    soundGenF32G ([\x -> closestNote (if x /= 0.0 then abs x else unsafeAt notes 0),\x -> fromMaybe (unsafeAt notes 0)+     (dNote (unsafeAt v5 (abs (j `rem` l0))) (closestNote (if x /= 0.0 then abs x else unsafeAt notes 0)))])+       (replicate 2 x) ([1,unsafeAt v5 (abs (j `rem` l0))]) f (x, y, t0) j vdB ys+    if null ys then mixTest else mixTest2G ys ++-- | Generalized variant of the 'overSoXSynth2FDN_Sf35G' with afterwards 'apply6G' usage.+overSoXSynth2FDN_Sf36G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> Array Int Float -> String -> Float -> IO ()+overSoXSynth2FDN_Sf36G f (x, y, t0) j v5 vdB ys vol+ | F.null v5 = overSoXSynthG f x+ | otherwise = overSoXSynth2FDN_Sf35G f (x, y, t0) j v5 vdB ys >>+    if y > 0.0 then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr ""++-- | A variant of the 'overSoXSynth2FDN_Sf36G' where volume adjustment is obtained from a Ukrainian text.+overSoXSynth2FDN_Sf36GS :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> String -> Array Int Float -> String -> String -> IO ()+overSoXSynth2FDN_Sf36GS f (x, y, t0) j v5 xs vdB ys xxs+ | null . convertToProperUkrainianS $ xxs = putStrLn "Composition.Sound.Functional.overSoXSynth2FDN_Sf36GS: You provided no information to obtain volume adjustment! "+ | otherwise = overSoXSynth2FDN_Sf36G f (x, y, t0) j (intervalsFromStringG v5 xs) vdB ys (str2Vol1 xxs)+{-# INLINE overSoXSynth2FDN_Sf36GS #-} ++-- | Can generate multiple notes with their respective overtones that are played simultaneously (e. g. it can be just one note with overtones,+-- an interval with overtones, an accord with overtones etc.). This allows to get a rather complex or even complicated behaviour to obtain expressive+-- and rich sound. It uses volume adjustment in dB given by the second @[Float]@ for the overtones.+soundGenF31G :: [(Float -> Float)] -> [Float] -> [Int] -> (Float -> OvertonesO) -> (Float, Float, Float) -> Int ->+  Array Int Float -> IO ()+soundGenF31G vf vd vi f (x, y, t0) j vdB = soundGenF32G vf vd vi f (x, y, t0) j vdB []+{-# INLINE soundGenF31G #-}++-- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf3' function. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthGen2FDN_Sf3G :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> Float -> String -> String ->+ ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> IO ()) -> IO ()+overSoXSynthGen2FDN_Sf3G file m ku f y t0 zs wws h = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+      zeroN = numVZeroesPre vecB+      v2    = str2DurationsDef n zs y+      !l2 = numElements v2 in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt v2 (j `rem` l2)), t0) j wws+        renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") . zip [0..] $ vecB+  endFromResult++-- | Generalized variant of the 'ovorSoXSynthGen2FDN_Sf3G' with a possibility to specify sound quality with the third 'String' argument.+-- Besides, the second from the end argument (a function) needs to be one more argument -- just also 'String'. +-- For more information, please, refer to 'soxBasicParams'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthGen2FDN_Sf3G2G :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> Float -> String -> String ->+ ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO ()+overSoXSynthGen2FDN_Sf3G2G file m ku f y t0 zs wws h ys = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+      zeroN = numVZeroesPre vecB+      v2    = str2DurationsDef n zs y+      !l2 = numElements v2 in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt v2 (j `rem` l2)), t0) j wws ys+        renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f"+          then ".flac" else ".wav") . zip [0..] $ vecB+  endFromResult2G ys  +
+ Composition/Sound/Functional/Basics.hs view
@@ -0,0 +1,383 @@+-- |+-- Module      :  Composition.Sound.Functional.Basics+-- 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. Is more complicated than+-- dobutokO2 and uses its functionality.++{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -threaded #-}++module Composition.Sound.Functional.Basics (+  -- * Type synonyms with different semantics+  SoundsO+  , OvertonesO+  , NotePairs+  -- * Work with notes (general)+  , notes+  , neighbourNotes+  , closestNote+  , pureQuintNote +  , overTones+  , overTonesALaClarinet+  -- * Work with overtones+  , overSoXSynth+  , overSoXSynthALaClarinet+  -- ** Generalized function+  , overSoXSynthG+  -- * Work with enky (extension to octaves functionality)+  , nkyT+  , whichOctave+  , whichOctaveG+  , whichEnka +  , enkuUp +  , enkuDown +  , liftInEnkuV+  , liftInEnku+  -- ** Work with octaves+  , octavesT+  -- * Combining intermediate files+  , mixTest+  , mixTest2+  -- * Working with files+  , freqsFromFile+  , endFromResult+  -- * Use additional function and Ukrainian texts and generates melody+  , dNote+  -- ** 2G generalized auxiliary functions+  , mixTest2G+  , mixTest22G+  , endFromResult2G+  -- ** Auxiliary functions+  , partialTest_k1G+  , partialTest_k2G+  , prependZeroes +  , nOfZeroesLog +  , numVZeroesPre+  , duration1000+  , adjust_dbVol+) where++import GHC.List (iterate')+import CaseBi.Arr (getBFstLSorted')+import Data.Char (isDigit)+import System.Exit (ExitCode( ExitSuccess ))+import Numeric+import Data.List (isPrefixOf,sort)+import Data.Maybe (fromJust,isJust,fromMaybe,mapMaybe)+import qualified Data.Foldable as F (find)+import GHC.Arr+import Sound.SoXBasics (durationA)+import System.Process+import EndOfExe+import System.Directory+import Composition.Sound.IntermediateF++-- | Is used to represent a sequence of intervals, each note being a 'Float' value (its frequency in Hz).+type SoundsO = Array Int (Float, Float)++-- | Is used to represent a set of overtones for the single sound, the first 'Float' value is a frequency and the second one -- an amplitude.+type OvertonesO = [(Float, Float)]++-- | Is used to represent a set of pairs of notes for each element of which the 'Float' values (notes frequencies in Hz) are somewhat+-- musically connected one with another..+type NotePairs = Array Int (Float, Float)++-- | Gets 'Int' frequencies from the given 'FilePath' using SoX. The frequencies are \"rough\" according to the SoX documentation and+-- the duration is too small so they can be definitely other than expected ones. Is used as a source of variable numbers (somewhat close each to another+-- in their order but not neccessarily). .+freqsFromFile :: FilePath -> Int -> IO [Int]+freqsFromFile file n = mapM (\k -> do {+    (_, _, herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file, "-n", "trim", showFFloat Nothing (fromIntegral k * 0.001) "",+      "0.001", "stat"] ""+    ; let line0s = lines herr+          noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s+    ; if null noteN0 then return (11440::Int)+      else let noteN1  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 }) [0..n-1]++-- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work+-- on them properly. Afterwards, the function deletes these combined files.+mixTest :: IO ()+mixTest = do+  paths0 <- listDirectory "."+  let paths = filter (isPrefixOf "test") $ paths0+  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""+  mapM_ removeFile paths++-- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to+-- 'soxBasicParams'.+mixTest2G :: String -> IO ()+mixTest2G ys = do+  paths0 <- listDirectory "."+  let paths = filter (isPrefixOf "test") $ paths0+  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result.wav","vol","0.3"]) ""+  mapM_ removeFile paths++-- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work+-- on them properly. Afterwards, the function deletes these combined files. The name of the resulting file depends on the first two command line+-- arguments so that it is easy to produce unique names for the consequent call for the function.+mixTest2 :: Int -> Int -> IO ()+mixTest2 zeroN j = do+  paths0 <- listDirectory "."+  let paths = filter (isPrefixOf "test") $ paths0+  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav",+    "vol","0.3"]) ""+  mapM_ removeFile paths++-- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to+-- 'soxBasicParams'. The name of the resulting file depends on the first two command line+-- arguments so that it is easy to produce unique names for the consequent call for the function.+mixTest22G :: Int -> Int -> String -> IO ()+mixTest22G zeroN j ys = do+  paths0 <- listDirectory "."+  let paths = filter (isPrefixOf "test") $ paths0+  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result" ++ prependZeroes zeroN (show j) +++      ".wav","vol","0.3"]) ""+  mapM_ removeFile paths  ++-- | Gets an \"end.wav\" file from the intermediate \"result\*.wav\" files in the current directory. If it is not successful, produces the notification+-- message and exits without error. If you would like to create the file if there are too many intermediate ones, please, run+-- \"dobutokO2 8\" or \"dobutokO2 80\" in the current directory.+endFromResult :: IO ()+endFromResult = do+  path2s <- listDirectory "."+  let paths3 = sort . filter (isPrefixOf "result") $ path2s+  (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""+  case code of+    ExitSuccess -> putStrLn "The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. "+    _           -> do+      exi <- doesFileExist "end.wav"+      if exi then removeFile "end.wav"+      else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >>+        putStrLn "Use them manually as needed."++-- | Similar to 'endFromResult', but uses additional 'String' argument to change sound quality parameters. For more information, please, refer to+-- 'soxBasicParams'.+endFromResult2G :: String -> IO ()+endFromResult2G ys = do+  path2s <- listDirectory "."+  let paths3 = sort . filter (isPrefixOf "result") $ path2s+  (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ soxBasicParams ys ["","end.wav"]) ""+  case code of+    ExitSuccess -> putStrLn $ "The final file \"end." ++ if drop 3 ys == "f" then "flac" else "wav" ++ "\" was successfully created. You can now manually change or delete \"result*\" files in the directory. "+    _           -> do+      exi <- doesFileExist $ "end." ++ if drop 3 ys == "f" then "flac" else "wav"+      if exi then removeFile $ "end." ++ if drop 3 ys == "f" then "flac" else "wav"+      else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >>+        putStrLn "Use them manually as needed."            ++-- | Generates part of the \"test\*\" files with the additional volume adjustment in dB given by 'Array' 'Int' 'Float'.+partialTest_k1G :: OvertonesO -> Int -> String -> Array Int Float -> IO ()+partialTest_k1G ks k ts arr2 = partialTest_k2G ks k ts arr2 []++-- | Generalized version of the 'partialTest_k1G' with a possibility to change sound quality parameters using the additional second 'String' argument.+-- For more information, please, refer to 'soxBasicParams'.+partialTest_k2G :: OvertonesO -> Int -> String -> Array Int Float -> String -> IO ()+partialTest_k2G ks k ts arr2 ys =+  let zeroN = numVZeroesPre ks in mapM_ (\(i, (noteN, !amplN)) -> if i /= 0 && i `rem` 50 == 0+    then do+      _ <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys (adjust_dbVol ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav",+         "synth", ts,"sine", showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""]+            (unsafeAt arr2 i))) ""+      path1s <- listDirectory "."+      let path2s = sort . filter (isPrefixOf $ "test" ++ show k) $ path1s+      (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ soxBasicParams ys ["","test-" ++ show k +++        prependZeroes zeroN (show (i `quot` 50)) ++ ".wav"]) ""+      case code of+        ExitSuccess -> mapM_ removeFile path2s+        _           -> do+          exi <- doesFileExist $ "test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav"+          if exi then putStrLn (herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav")+          else putStrLn herr0+    else readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) (((\wwws -> adjust_dbVol wwws (unsafeAt arr2 i))) ["-r22050", "-n", "test" ++ show k ++ show (i + 2) ++ ".wav",+       "synth", ts,"sine", showFFloat Nothing (abs noteN) "", "vol", showFFloat Nothing amplN ""])) "" >> putStr "") . zip [0..] $ ks++-- | Auxiliary function to get from a sound file specified a duration parameter @n@ that can be used further.+duration1000 :: FilePath -> IO Int+duration1000 file = fmap (\t -> truncate (t / 0.001)) . durationA $ file++-- | Function to get from the number of semi-tones and a note a 'Maybe' note for the second lower note in the interval if any. If there is+-- no need to obtain such a note, then the result is 'Nothing'.+dNote :: Int -> Float -> Maybe Float+dNote n note+  | n == 0 || compare note (unsafeAt notes 0) == LT || compare note (unsafeAt notes 107) == GT = Nothing+  | otherwise = Just (note / 2 ** (fromIntegral n / 12))++-- | 'Array' of musical notes in Hz.+notes :: Array Int Float+-- notes V.! 57 = 440.0   -- A4 in Hz+notes = listArray (0,107) . map (\t ->  440 * 2 ** (fromIntegral (t - 57) / 12)) $ [0..107]++-- | Function returns either the nearest two musical notes if frequency is higher than one for C0 and lower than one for B8+-- or the nearest note duplicated in a tuple.+neighbourNotes :: Float -> (Int,Int) -> (Float, Float)+neighbourNotes x (!ll,!mm)+  | x <= unsafeAt notes ll = (unsafeAt notes ll, unsafeAt notes ll)+  | x >= unsafeAt notes mm = (unsafeAt notes mm, unsafeAt notes mm)+  | mm - ll > 1 = if x <= unsafeAt notes ((mm + ll) `quot` 2)+      then neighbourNotes x (ll, (mm + ll) `quot` 2)+      else neighbourNotes x ((mm + ll) `quot` 2, mm)+  | otherwise = (unsafeAt notes ll, unsafeAt notes mm)++-- | Returns the closest note to the given frequency in Hz.  +closestNote :: Float -> Float+closestNote x+ | x > 0.0 =+    let (x0, x2) = neighbourNotes x (0,107)+        r0       = x / x0+        r2       = x2 / x in +    if r2 > r0 then x0 else x2+ | otherwise = 0.0++-- | Additional function to prepend zeroes to the given 'String'. The number of them are just that one to fulfill the length to the given 'Int' parameter.+prependZeroes :: Int -> String -> String +prependZeroes n xs +  | if n <= 0 || null xs then True else n <= length xs = xs+  | otherwise = replicate (n - length xs) '0' ++ xs+{-# INLINE prependZeroes #-}  ++nOfZeroesLog :: Int -> Maybe Int+nOfZeroesLog x+  | x <= 0 = Nothing+  | otherwise = Just (truncate (logBase 10 (fromIntegral x)) + 1)+{-# INLINE nOfZeroesLog #-}  ++-- | Is a minimal number of decimal places that are just enough to represent a length of the list given. For an [] returns 0.+numVZeroesPre :: [a] -> Int+numVZeroesPre ks = fromMaybe (0 :: Int) (nOfZeroesLog . length $ ks)+{-# INLINE numVZeroesPre #-}      ++-- | Similarly to 'liftInOctaveV' returns a ['Float'] (actually frequencies) for the n-th elements set of notes (see 'nkyT') instead of octaves.+-- A second 'Int' parameter defines that @n@. +liftInEnkuV :: Int -> Int -> [Float] -> [Float]+liftInEnkuV n ku = mapMaybe (liftInEnku n ku)++-- | Similarly to 'liftInOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT').+-- A second 'Int' parameter defines that @n@. Not all pairs return 'Just' @x@. +liftInEnku :: Int -> Int -> Float -> Maybe Float+liftInEnku n ku x+  | n < 0 || n > ((108 `quot` ku) - 1) = Nothing+  | getBFstLSorted' False (zip [2,3,4,6,9,12] . repeat $ True) ku && closestNote x > 24.4996 =+      case compare (fromJust . whichEnka ku $ x) n of+        EQ -> Just (closestNote x)+        LT -> let z  = logBase 2.0 (unsafeAt notes (n * ku) / closestNote x)+                  z1 = truncate z in+                   if abs (z - fromIntegral z1) > 0.999 || abs (z - fromIntegral z1) < 0.001+                     then Just (last . take  (fromIntegral z1 + 1) . iterate' (enkuUp ku) $ closestNote x)+                     else Just (last . take  (fromIntegral z1 + 2) . iterate' (enkuUp ku) $ closestNote x)+        _  -> let z  = logBase 2.0 (closestNote x / unsafeAt notes (n * ku))+                  z1 = truncate z in+                   if abs (z - fromIntegral z1) > 0.999 || abs (z - fromIntegral z1) < 0.001+                     then Just (last . take (fromIntegral z1 + 2) . iterate' (enkuDown ku) $ closestNote x)+                     else Just (last . take (fromIntegral z1 + 1) . iterate' (enkuDown ku) $ closestNote x)+  | otherwise = Nothing++-- | Similarly to 'whichOctave' returns a 'Maybe' number for the n-th elements set of notes (see 'nkyT').+-- An 'Int' parameter defines that @n@.+whichEnka :: Int -> Float -> Maybe Int+whichEnka n x+  | getBFstLSorted' False (zip [2,3,4,6,9,12] . repeat $ True) n && closestNote x >= unsafeAt notes 0 && closestNote x < unsafeAt notes (108 - n) = Just (round (logBase (2 ** (fromIntegral n / 12.0)) ((fst . fromJust . F.find (\(t1, _) -> closestNote x < t1) $ nkyT n) / unsafeAt notes 0) - 1))+  | getBFstLSorted' False (zip [2,3,4,6,9,12] . repeat $ True) n && closestNote x >= unsafeAt notes (108 - n) = Just (108 `quot` n)+  | otherwise = Nothing ++-- | Returns an analogous note in the higher n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@.+enkuUp  :: Int -> Float -> Float+enkuUp n x+  | getBFstLSorted' False (zip [2..11] . repeat $ True) n = 2 ** (fromIntegral n / 12) * x+  | otherwise = 2 * x+{-# INLINE enkuUp #-}  ++-- | Returns an analogous note in the lower n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@.+enkuDown  :: Int -> Float -> Float+enkuDown n x+  | getBFstLSorted' False (zip [2..11] . repeat $ True) n = 2 ** (fromIntegral (-n) / 12) * x+  | otherwise = x / 2+{-# INLINE enkuDown #-}++-- | Returns a 'Array' 'Int' of tuples with the lowest and highest frequencies for the notes in the sets consisting of @n@ consequential notes+-- (including semi-tones). An 'Int' argument defines this @n@. It can be 2, 3, 4, 6, 9, or 12 (the last one is for default octaves, see 'octavesT').+-- So for different valid @n@ you obtain doubles, triples and so on. The function being applied returns a 'Array' 'Int' of such sets with+-- their respective lowest and highest frequencies.+nkyT :: Int -> NotePairs+nkyT n+  | getBFstLSorted' False (zip [2,3,4,6,9,12] . repeat $ True) n = amap (\i -> (unsafeAt notes (i * n),+       unsafeAt notes (i * n + (n - 1)))) . listArray (0,k) $ [0..k]+  | otherwise = octavesT+     where !k = (108 `quot` n) - 1++-- | Returns a 'Array' 'Int' of tuples with the lowest and highest frequencies for the notes in the octaves.+octavesT :: NotePairs+octavesT = amap (\i -> (unsafeAt notes (i * 12), unsafeAt notes (i * 12 + 11))) . listArray (0,8) $ [0..8]++-- | 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.+overSoXSynth :: Float -> IO ()+overSoXSynth = overSoXSynthG overTones+{-# INLINE overSoXSynth #-}++-- | Similar to 'overSoXSynth' but uses 'overTonesALaClarinet' instead of 'overTones'.+overSoXSynthALaClarinet :: Float -> IO ()+overSoXSynthALaClarinet = overSoXSynthG overTonesALaClarinet+{-# INLINE overSoXSynthALaClarinet #-}++-- | Generalized variant of the 'overSoXSynth' with the possibility to set the variant of the overtones for the notes as the+-- first argument.+overSoXSynthG :: (Float -> OvertonesO) -> Float -> IO ()+overSoXSynthG g x = do+  let !note0 = if x /= 0.0 then closestNote (abs x) else unsafeAt notes 0+      !note1 = pureQuintNote note0+      !v0    = g note0+      !v1    = g note1+      overSoXSynthHelp = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+        ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") . zip [0..]+      overSoXSynthHelp2 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+        ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat Nothing noteN "", "vol", showFFloat Nothing amplN ""] "") . zip [0..]+  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", showFFloat Nothing note0 "", "synth", "0.5","sine", "mix", showFFloat Nothing note1 "", "vol","0.5"] ""+  overSoXSynthHelp v0+  overSoXSynthHelp2 v1+  mixTest++-- | Returns a pure quint lower than the given note.+pureQuintNote :: Float -> Float+pureQuintNote x = x / 2 ** (7 / 12)+{-# INLINE pureQuintNote #-}++-- | For the given frequency of the note it generates a list of the tuples, each one of which contains the harmonics' frequency and amplitude.+overTones :: Float -> OvertonesO+overTones note =+  takeWhile (\(!w,!z) -> w <= unsafeAt notes 107 && abs z > 0.001) . map (\i ->+    (note * fromIntegral (i + 2), 1 / fromIntegral ((i + 1) * (i + 1)))) $ [0..1023]++overTonesALaClarinet :: Float -> OvertonesO+overTonesALaClarinet note =+  takeWhile (\(!w,!z) -> w <= unsafeAt notes 107 && abs z > 0.001) . map (\i ->+    (note * fromIntegral (2 * i + 1), 1 / fromIntegral ((i + 1) * (i + 1)))) $ [0..512]++-- | Function can be used to determine to which octave (in the American notation for the notes, this is a number in the note written form,+-- e. g. for C4 this is 4) the frequency belongs (to be more exact, the closest note for the given frequency -- see 'closestNote' taking into account+-- its lower pure quint, which can lay in the lower by 1 octave). If it is not practical to determine the number, then the function returns 'Nothing'.+whichOctave :: Float -> Maybe Int+whichOctave x+  | closestNote x >= 24.4996 && closestNote x < unsafeAt notes 95 = Just (round (logBase 2 ((fst . fromJust . F.find (\(t1, _) -> closestNote x < t1) $ octavesT) / unsafeAt notes 0) - 1))+  | closestNote x >= unsafeAt notes 95 = Just 8+  | otherwise = Nothing++-- | Generalized version of the 'whichOctave'.+whichOctaveG :: Float -> Maybe Int+whichOctaveG x +  | closestNote x >= unsafeAt notes 0 && x <= unsafeAt notes 95 = Just (round (logBase 2 ((fst . fromJust . F.find (\(t1, _) -> closestNote x < t1) $ octavesT) / unsafeAt notes 0) - 1))+  | closestNote x >= unsafeAt notes 95 = Just 8+  | otherwise = Nothing++-- | Is used internally in the 'readProcessWithExitCode' to adjust volume for the sound with additional dB value given by 'Float' argument.+adjust_dbVol :: [String] -> Float -> [String]+adjust_dbVol xss y+ | y == 0.0 = xss+ | otherwise = xss ++ ["vol",showFFloat Nothing y "dB"]++
+ Composition/Sound/Functional/Elements.hs view
@@ -0,0 +1,270 @@+{-# OPTIONS_GHC -threaded #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      :  Composition.Sound.Functional.Elements+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.++module Composition.Sound.Functional.Elements (+  -- * Functions to edit OvertonesO and function f+  renormF+  , uniq+  , luniq+  , renormFD+  , sameOvertone+  , sameFreqF+  , sameFreqFI+  , fAddFElem+  , fRemoveFElem+  , fChangeFElem+  , gAdd01+  , gAdd02+  , gAdd03+  , gAdd04+  , gRem01+  , gRem02+  , gRem03+  -- ** Working with two OvertonesO+  , fAddFElems+  , fRemoveFElems+  , fChangeFElems+  , freqsOverlapOvers+  , elemsOverlapOvers+  , gAdds01+  , gAdds02+) where++import Data.List+--import qualified Data.Vector as V+import GHC.Arr+import qualified Data.Foldable as F+import Data.Maybe (fromJust)+import Data.Foldable.Ix+import Composition.Sound.Functional.Basics++-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not []) is equal by the absolute value+-- to 1.0 and the mutual ratios of the amplitudes are preserved.+renormF :: OvertonesO -> OvertonesO+renormF v+ | null v = []+ | otherwise =+    let v1 = sortBy (\(_,y1) (_,y2)-> compare (abs y2) (abs y1)) v in+      if (\(_,y) -> y == 0.0) . head $ v1 then []+      else map (\(x,y) -> (x, y / (snd . head $ v1))) v1++-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not []) is equal by the absolute value+-- to 'Float' argument and the mutual ratios of the amplitudes are preserved.+renormFD :: Float -> OvertonesO -> OvertonesO+renormFD ampl0 v+ | null v = []+ | otherwise =+    let v1 = sortBy (\(_,y1) (_,y2)-> compare (abs y2) (abs y1)) v in+      if (\(_,y) -> y == 0.0) . head $ v1 then []+      else map (\(x,y) -> (x, ampl0 * y / (snd . head $ v1))) v1++-- | Predicate to check whether all tuples in the list have the same first element.+sameOvertone :: OvertonesO -> Bool+sameOvertone v+ | null v = False+ | otherwise = all (\(x,_) -> x == k) v+     where !k = fst . head $ v++-- | @g :: (Float,Float) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'. It depends+-- only on the element being added and the actual 'OvertonesO'. It does not depend on the 'Float' argument for @f :: Float -> OvertonesO@+-- so for different 'Float' for @f@ it gives the same result.+sameFreqF :: Float -> (Float,Float) -> (Float -> OvertonesO) -> ((Float,Float) -> OvertonesO -> OvertonesO) -> OvertonesO+sameFreqF freq (noteN0,amplN0) f g = g (noteN0,amplN0) (f freq)++-- | @g :: (Float,Float) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'.+-- Variant of 'sameFreqF' where g depends only on the elements of the 'OvertonesO', which first elements in the tuples equal to the first element+-- in the @(Float,Float)@. It does not depend on the 'Float' argument for @f :: Float -> OvertonesO@+-- so for different 'Float' for @f@ it gives the same result.+sameFreqFI :: Float -> (Float,Float) -> (Float -> OvertonesO) -> ((Float,Float) -> OvertonesO -> OvertonesO) -> OvertonesO+sameFreqFI freq (noteN0,amplN0) f g = g (noteN0,amplN0) . filter (\(x,_) -> x == noteN0) $ f freq++-- | @gAdd :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO@ is a function that defines how the element is added+-- to the 'OvertonesO'. 'fAddFElem' is +-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task +-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example similar to that ones that +-- are used for quantum mechanics and quantum field theory). +-- @gAdd@ allows not only to insert an element if missing, but to change all the 'OvertonesO' system. So depending on the complexity,+-- it can produce rather complex behaviour.+fAddFElem :: (Float, Float) -> (Float -> OvertonesO) -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO) ->+  (Float -> OvertonesO)+fAddFElem (noteN, amplN) f gAdd t = gAdd (noteN, amplN) t f++-- | @gRem:: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO@ is a function that defines how the element is removed+-- from the 'OvertonesO'. 'fRemoveFElem' is+-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task +-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example that ones that are used +-- for quantum mechanics and quantum field theory). +-- @gRem@ allows not only to delete an element if existing, but to change all the 'OvertonesO' system. So depending on the complexity,+-- it can produce rather complex behaviour.+fRemoveFElem :: (Float, Float) -> (Float -> OvertonesO) -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO) -> +  (Float -> OvertonesO)+fRemoveFElem (noteN, amplN) f gRem t = gRem (noteN, amplN) t f++-- | Changes elements of the 'OvertonesO' using two functions. It is a generalization of the 'fAddFElem' and 'fRemoveFElem' functions. For example, if the first +-- of the two inner functional arguments acts as 'gAdd01' or similar, then it adds element to the 'OvertonesO', if it acts as 'gRem01', then it removes the element. +-- Its behaviour is defined by the 'Float' parameter (meaning frequency, probably), so you can change elements depending on what point it is applied.+fChangeFElem :: (Float, Float) -> Float -> (Float -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> +  (Float -> OvertonesO)+fChangeFElem (noteN, amplN) freq h f t = (h freq) (noteN, amplN) t f++-- | Example of the function gAdd for the 'fAddFElem'. If the frequency is already in the 'OvertonesO' then the corresponding amplitude is divided+-- equally between all the elements with the repeated given frequency from @(Float, Float)@. Otherwise, it is just concatenated to the 'OvertonesO'.+gAdd01 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO+gAdd01 (note,ampl) freq f + | null . f $ freq = [(note,ampl)]+ | otherwise =+    let v1 = renormF . f $ freq in+     let v2 = findIdxsL1 note . map fst $ v1+         !ampl' = ampl / fromIntegral (length v2) in+          if null v2 then (note,ampl) : f freq+          else renormF . map (\(i, (t,w)) -> if i `elem` v2 then (t,w + ampl') else (t,w)) .+           zip [0..] $ v1++-- | Can be used to produce an example of the function @gAdd@ for the 'fAddFElem'. Similar to 'gAdd01', but uses its first argument+-- to renorm the result of the 'gAdd01' so that its maximum by absolute value amplitude equals to the first argument.+gAdd02 :: Float -> (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO+gAdd02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq++-- | Example of the function @gAdd@. for the 'fAddFElem'. If the frequency is not already in the 'OvertonesO' then the corresponding element is added and+-- the 'OvertonesO' are renormed with 'renormF'. Otherwise, the element is tried to be inserted with a new frequency between the greatest by an absolute+-- values notes as an intermediate value with the respective amplitude, or if there is only one element, to produce two elements in+-- the resulting list with two consequent harmonics.+gAdd03 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO+gAdd03 (note,ampl) freq f + | null . f $ freq = [(note,ampl)]+ | otherwise =+    let v1 = renormF . f $ freq in+     let v2 = findIdxsL1 note . map fst $ v1 in+       if null v2 then renormF ((note,ampl) : f freq)+       else+        let xs = sortBy (\(x1,_) (x2,_)-> compare (abs x2) (abs x1)) v1+            l = length v1+            ys = if l > 1 then ((fst . head $ xs) + (fst . head . tail $ xs) / 2,ampl):xs+                 else [(note,((snd . head $ v1) + ampl) / 2),(2 * note,(abs ((snd . head $ v1) - ampl)) / 2)] in renormF ys++-- | Example of the function gRem for the 'fRemoveFElem'. If the element is already in the 'OvertonesO' then it is removed (if there are more than 5+-- elements already) and 'OvertonesO' are renormalized. Otherwise, all the same for the element already existing elements become less in an amlitude+-- for a numbers that in sum equal to amplitude of the removed element.+gRem01 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO+gRem01 (note,ampl) freq f+  | null . f $ freq = []+  | otherwise =+     let v1 = renormF . f $ freq in+     let v2 = findIndices (\(x,y) -> x == note && y == ampl) v1+         !ampl' = ampl / fromIntegral (length v2) in+       if null v2 then+       if length v1 > 5 then renormF . take (length v1 - 1) $ v1+       else v1+       else renormF . map (\(i, (t,w)) -> if i `elem` v2 then (t,w - ampl') else (t,w)) .+         zip [0..] $ v1++-- | Can be used to produce an example of the function @gRem@ for the 'fRemoveFElem'. Similar to 'gRem01', but uses its first argument+-- to renorm the result of the 'gRem01' so that its maximum by absolute value amplitude equals to the first argument.+gRem02 :: Float -> (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO+gRem02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq++-- | Similar to 'fAddFElem', but instead of one element @(Float,Float)@ it deals with a list of such elements that is 'OvertonesO'. +fAddFElems :: OvertonesO -> (Float -> OvertonesO) -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO) ->+  (Float -> OvertonesO)+fAddFElems v f gAdds t = gAdds v t f++-- | Similar to 'fRemoveFElem', but instead of one element @(Float,Float)@ it deals with a list of such elements that is 'OvertonesO'. +fRemoveFElems :: OvertonesO -> (Float -> OvertonesO) -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO) -> +  (Float -> OvertonesO)+fRemoveFElems v f gRems t = gRems v t f++-- | Similar to 'fChangeFElem', but use another form of the changing function, so it can deal with not only single element of the 'OvertonesO', +-- but also with several ones.+fChangeFElems :: OvertonesO -> Float -> (Float -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> +  (Float -> OvertonesO)+fChangeFElems v freq h f t = (h freq) v t f++-- | Binary predicate to check whether two given 'OvertonesO' both have the elements with the same first element in the tuples. If 'True' then+-- this means that 'OvertonesO' are at least partially overlaped by the first elements in the tuples (meaning frequencies). +freqsOverlapOvers :: OvertonesO -> OvertonesO -> Bool+freqsOverlapOvers v1 v2 =+  let [v11,v21] = map (map fst) [v1,v2]+      v22 = filter (<= maximum v11) v21 in+        if null v22 then False+        else+          let v12 = filter (>= minimum v21) v11+              [v13,v23] = map (uniq . sort) [v12,v22]+              [l1,l2]  = map length [v13,v23] in+                (luniq . sort . concat $ [v13,v23]) < (l1 + l2)++uniq :: (Eq a) => [a] -> [a]+uniq = foldr f v+  where v = []+        f x xs+          | x == head xs = xs+          | otherwise = x:xs++luniq :: (Eq a) => [a] -> Int+luniq xs = snd . foldr f v $ xs+  where v = ([],0)+        f x (xs,i)+          | x == head xs = (xs, i)+          | otherwise = (x:xs, i + 1)++-- | Similar to 'freqsOverlapOvers', but checks whether the whole tuples are the same instead of the first elements in the tuples are the same.+elemsOverlapOvers :: OvertonesO -> OvertonesO -> Bool+elemsOverlapOvers v1 v2 =+  let v22 = filter (\(x,_) -> x <= fst (maximumBy (\(x1,_) (t,_) -> compare x1 t) v1)) v2 in+        if null v22 then False+        else+          let v12 = filter (\(x,_) -> x >= fst (minimumBy (\(x1,_) (t,_) -> compare x1 t) v2)) v1+              [v13,v23] = map (uniq . sort) [v12,v22]+              [l1,l2]  = map length [v13,v23] in (luniq . sort . concat $ [v13,v23]) < (l1 + l2)++-- | Example of the function @gAdds@ for the 'fAddFElems'. +gAdds01 :: OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO+gAdds01 v0 freq f + | null . f $ freq = v0+ | freqsOverlapOvers v0 (f freq) =+     let ys = sortBy (\(x1,_) (x2,_) -> compare x1 x2) v0+         h ys+          | null ys = []+          | otherwise = (takeWhile (not . (/= head ys)) ys):h (dropWhile (not . (/= head ys)) ys)+         h1 = map (\zs -> (sum . map snd $ zs) / fromIntegral (length zs)) . h+         h2 ys = map (fst . head) (h ys)+         v2   = zip (h2 ys) (h1 ys)+         us = sortBy (\(x1,_) (x2,_) -> compare x1 x2) $ f freq+         v3   = zip (h2 us) (h1 us) in renormF . concat $ [v2,v3]+ | otherwise = renormF . concat $ [v0, f freq]++-- | Can be used to produce an example of the function @gAdds@ for the 'fAddFElems'. Similar to 'gAdds01', but uses its first argument+-- to renorm the result of the 'gAdds01' so that its maximum by absolute value amplitude equals to the first argument.+gAdds02 :: Float -> OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO+gAdds02 amplMax v0 freq = renormFD amplMax . gAdds01 v0 freq++-- | Example of the function @gAdd@. for the 'fAddFElem'. It tries to insert the given ('Float','Float') into the less dense frequency region.+gAdd04 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO+gAdd04 (note,ampl) freq f + | null . f $ freq = [(note,ampl)]+ | otherwise =+    let v1 = sortBy (\(x1,_) (x2,_) -> compare x1 x2) . f $ freq+        v2 = zipWith (\(x1,_) (x2,_) -> x2 - x1) v1 (s2L 1 (length v1 - 1) v1)+        !mx = maximum v2+        idxMax = fromJust . findIndex (== mx) $ v2+        newFreq = (fst (v1 !! (idxMax + 1)) + fst (v1 !! idxMax)) / 2 in (newFreq,ampl) : v1++-- | Example of the function @gRem@ for the 'fRemFElem'. It tries not to remove elements from the less than 6 elements 'OvertonesO' and to remove+-- all the elements in the given range with the width of the twice as many as the second 'Float' in the first argument tuple and the centre+-- in the first 'Float' in the tuple. Similar to somewhat bandreject filter but with more complex behaviour for the sound to be more complex.+gRem03 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO+gRem03 (note,halfwidth) freq f =+ let v1 = filter (\(x,_) -> abs (x - note) <= halfwidth) . f $ freq in+   if length v1 <= 5 then renormF . map (\i -> (fromIntegral (i + 1) * note, halfwidth / fromIntegral (i + 3))) $ [0..4]+   else v1+
+ Composition/Sound/Functional/Params.hs view
@@ -0,0 +1,521 @@+-- |+-- Module      :  Composition.Sound.Functional.Params+-- 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. Is more complicated than+-- dobutokO2 and uses its functionality.++{-# LANGUAGE BangPatterns, LambdaCase #-}+{-# OPTIONS_GHC -threaded #-}++module Composition.Sound.Functional.Params (+  Params (..)+  -- * Type synonyms with different semantics+  , Durations+  , Strengths+  , Intervals+  -- * New generalizations for scales and modes with Params+  , filterInParams+  , sortNoDup+  , toneD+  , toneE+  , liftInParams+  , liftInParamsV+  , lengthP+  , elemP+  , elemCloseP+  , showD+  , isStrParams+  , isListParams+  -- ** Application of the Params+  , overSoXSynthGen2FDN_SG4GPar+  , overSoXSynthGen2FDN_SG6GPar+  , overSoXSynthGen2FDN_SG2GPar+  , overSoXSynthGen2FDN_Sf3GPar+  , overSoXSynthGen2FDN_Sf3G2GPar  +  -- * Creating melody from overtones+  , overMeloPar+  -- * Additional functions+  , str2DurationsDef+  , signsFromString+  , apply6Gf+  , apply6GSilentFile+  , vStrToVIntG+  , strToIntG+  , defInt+  , syllableStr+  , overSoXSynth2FDN_Sf32G+  , intervalsFromString+  , soundGenF32G+  , helpF0+  , helpF1+  , doubleVecFromVecOfFloat+) where++import CaseBi.Arr (getBFstLSorted',getBFstL')+import Numeric+import Data.List (sort,zip4,elemIndex)+import Data.Maybe (isNothing,fromJust,isJust,fromMaybe,mapMaybe)+import GHC.Arr+import System.Process+import System.Exit+import EndOfExe+import System.Directory+import Languages.Phonetic.Ukrainian.Syllable.Arr+import Melodics.ByteString.Ukrainian.Arr (convertToProperUkrainianS)+import Sound.SoXBasics (upperBnd,selMaxAbs)+import MMSyn7l+import qualified Data.Foldable as F+import Composition.Sound.IntermediateF+import Composition.Sound.Functional.Basics+import Data.Foldable.Ix++-- | Representation of the scales and modes for the notes. Can be extended further, but for a lot of situations the following realization is sufficient. +-- See, for example, 'filterInParams' and so on. 'String' is (are) used as a general classification name, for some of them there are provided two +-- 'String' to classify. Lists are used to specify remainders in some meaning. See also, 'liftInParams' and 'toneE' ('toneD') functions, 'elemP' and +-- 'elemCloseP', 'lengthP' and 'showD'.+data Params = P2 Int Int | P2s Int Int String | P3sf Int Int Int String | P4lsf Int Int Int [Int] String | P32sf Int Int Int String String + | P3lf Int Int [Int] deriving (Eq, Ord, Show)++-- | Is used to represent a set of durations parameters of the sounds and pauses. The positive value corresponds to the sound +-- and the negative one -- to the pause.+type Durations = Array Int Float++-- | Is used to represent a set of volumes in the amplitude scale for SoX \"vol\" effect.+type Strengths = Array Int Float++-- | Is used to represent a set of intervals for notes (each element is a number of semi-tones between parts of interval). +-- Positive values corresponds to lower notes and negative to higher ones.+type Intervals = Array Int Int++-- | Additional function to produce signs from the given 'String' of the Ukrainian text. Ukrainian vowels and voiced consonants gives \"+\" sign (+1), voiceless+-- and sonorous consonants gives \"-\" sign (-1). \"сь\" and \"ць\" gives "0". Other symbols are not taken into account.+signsFromString :: Int -> String -> Array Int Int+signsFromString n1 =+  (\rs -> listArray (0,length rs - 1) rs) . take n1 . concatMap (fmap (\case+      UZ _ W -> 1+      UZ _ D -> 1+      UZ _ K -> 1+      UZ _ L -> (-1)+      UZ _ M -> (-1)+      UZ _ S -> (-1)+      UZ _ O -> (-1)+      _ -> 0) . concat) . createSyllablesUkrS . take (3 * n1) . cycle + +-- | Generalized version of the 'overSoXSynthGen2FDN_SG4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthGen2FDN_SG4GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> IO ()+overSoXSynthGen2FDN_SG4GPar file params f y arr2 wws h = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+      zeroN = numVZeroesPre vecB in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt arr2 (j `rem` numElements arr2))) j wws+        renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") . zip [0..] $ vecB+  endFromResult  +   +-- | Generalized version of the 'overSoXSynthGen2FDN_SG6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthGen2FDN_SG6GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> +  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> Strengths -> Float -> IO ()+overSoXSynthGen2FDN_SG6GPar file params f y v2 wws h v6 limV+ | F.null v6 = putStrLn "You did not provide a volume adjustments array! "+ | otherwise = do+    n <- duration1000 file+    xs <- freqsFromFile file n+    let ys = liftInParamsV params . map fromIntegral $ xs+        !l6 = numElements v6+        !l2 = numElements v2+        zeroN = numVZeroesPre ys in mapM_ (\(j, x) -> do+          h f (x, (unsafeAt v2 (j `rem` l2))) j wws+          renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav"+          apply6GSilentFile ("result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") limV (unsafeAt v6 (j `rem` l6))) .+            zip [0..] $ ys+    endFromResult++-- | Generalized version of the 'overSoXSynthGen2FDN_SG2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthGen2FDN_SG2GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> String -> String -> ((Float -> OvertonesO) ->+  (Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO ()+overSoXSynthGen2FDN_SG2GPar file params f y zs wws h ys = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+      zeroN = numVZeroesPre vecB+      v2    = str2DurationsDef n zs y+      !l2 = numElements v2 in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt v2 (j `rem` l2))) j wws ys+        renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) +++          if drop 3 ys == "f" then ".flac" else ".wav") . zip [0..] $ vecB+  endFromResult2G ys    ++-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthGen2FDN_Sf3GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Float -> String -> String ->+ ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> IO ()) -> IO ()+overSoXSynthGen2FDN_Sf3GPar file params f y t0 zs wws h = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+      zeroN = numVZeroesPre vecB+      v2    = str2DurationsDef n zs y+      !l2 = numElements v2 in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt v2 (j `rem` l2)), t0) j wws+        renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") . zip [0..] $ vecB+  endFromResult  ++-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthGen2FDN_Sf3G2GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Float -> String -> String ->+ ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO ()+overSoXSynthGen2FDN_Sf3G2GPar file params f y t0 zs wws h ys = do+  n <- duration1000 file+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+      zeroN = numVZeroesPre vecB+      v2    = str2DurationsDef n zs y+      !l2 = numElements v2 in mapM_ (\(j, x) -> do+        h f (x, (unsafeAt v2 (j `rem` l2)), t0) j wws ys+        renameFile ("result." ++ if drop 3 ys == "f" then "flac" else "wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ if drop 3 ys == "f"+          then ".flac" else ".wav") . zip [0..] $ vecB+  endFromResult2G ys    ++-- | A way to get from a 'Params' a corresponding 'Array' 'Int' of 'Float' (if any) and so to work with them further. May contain some issues +-- so please, before production usage check thoroughly. +-- For information there were used the following: +-- +-- https://en.wikipedia.org/wiki/Mode_(music)+-- +-- https://en.wikipedia.org/wiki/Ukrainian_Dorian_scale+-- +-- https://en.wikipedia.org/wiki/List_of_musical_scales_and_modes+-- +-- https://en.wikipedia.org/wiki/Octatonic_scale+-- +-- several other articles in the English Wikipedia +-- +-- and in Ukrainian: 	+-- Смаглій Г., Маловик Л. Теорія музики : Підруч. для навч. закл. освіти, культури і мистецтв / Г.А. Смаглій. -- Х. : Вид-во \"Ранок\", 2013. -- 392 с. +-- ISBN 978-617-09-1294-7+-- +filterInParams :: Params -> Maybe (Array Int Float)+filterInParams (P3lf n2 nL zs) -- generalized sound series, e. g. the chromatic ones etc.+ | all (>= 0) ([nL,107 - nL - n2,n2 - 2] ++ zs) = +    if any (\(i, _) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . +     zip [0..] . sliceToList nL n2 $ notes+      then Just (h4 . filter (\(i, _) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes)+      else Nothing+ | otherwise = Nothing+filterInParams (P32sf nT n2 nL xs ys) -- dur and moll in various their modifications+ | all (>= 0) [107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 12] = +    case xs of +      "dur" -> getBFstL' Nothing (zip ["FloatH","H","Full","Full moll","M","N"] . fmap Just $ +        [h4 . filter (\(i,_) -> toneD i nL nT [2,3,6,8,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 .+          filter (\(i,_) -> toneD i nL nT [1,3,5,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 .+           filter (\(i,_) -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,3,5]) . zip [0..] .+             sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,3,5,9,11]) .+              zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,3,5,8,10]) . zip [0..] .+                sliceToList nL n2 $ notes]) ys+      "moll" -> getBFstL' Nothing (zip ["FloatH1","H","Full","Full dur","M","N"] . fmap Just $ +        [h4 . filter (\(i,_) -> toneD i nL nT [1,4,5,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 .+         filter (\(i,_) -> toneD i nL nT [1,4,6,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) ->+          ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,4,6]) . zip [0..] . sliceToList nL n2 $+            notes, h4 . filter (\(i,_) -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6]) .+             zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,4,6,8,10]) .+              zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,4,6,9,11]) .+               zip [0..] . sliceToList nL n2 $ notes]) ys+      _   -> Nothing+ | otherwise = Nothing+filterInParams (P4lsf nT n2 nL zs xs) + | all (>= 0) ([107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 2]  ++ zs) = +    case xs of+     "ditonic" -> +       if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) +        i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 2 +         then Nothing+         else +           if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 2 . sortNoDup . filter (< n2) $ zs) $ +            replicate n2 True) i) . zip [0..] . sliceToList nL n2 $ notes)+             then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 2 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) +               i) . zip [0..] . sliceToList nL n2 $ notes)+             else Nothing+     "tritonic" -> +       if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) +        i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 3 +         then Nothing+         else +           if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 3 . sortNoDup . filter (< n2) $ zs) . +            replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes)+             then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 3 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) +               i) . zip [0..] . sliceToList nL n2 $ notes)+             else Nothing+     "tetratonic" -> +       if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) +        i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 4 +         then Nothing+         else +           if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 4 . sortNoDup . filter (< n2) $ zs) .  +            replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes)+             then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 4 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) +               i) . zip [0..] . sliceToList nL n2 $ notes)+             else Nothing+     "octatonic" -> +       if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) +        i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 8 +         then Nothing+         else +           if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 8 . sortNoDup . filter (< n2) $ zs) . +            replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes)+             then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 8 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) +               i) . zip [0..] . sliceToList nL n2 $ notes)+             else Nothing+     _   -> Nothing+ | nL >= 0 && nL <= 107 && n2 == 1 && xs == "monotonic" = Just (listArray (0,0) . (:[]) $ (unsafeAt notes nL))+ | otherwise = Nothing+filterInParams (P2 nL n2) + | all (>= 0) [107 - nL - n2,nL,n2 - 2] = Just ((\rs -> listArray (0,length rs - 1) rs) . sliceToList nL n2 $ notes) + | otherwise = Nothing+filterInParams (P2s nL n2 xs) + | all (>= 0) [107 - nL - n2,nL,n2 - 12] = +    getBFstLSorted' Nothing (zip ["Egyptian pentatonic", "Prometheus hexatonic scale", "Ukrainian Dorian scale", "augmented hexatonic scale", +      "blues major pentatonic", "blues minor pentatonic", "blues scale", "major hexatonic scale", "major pentatonic", "minor hexatonic scale", +        "minor pentatonic", "tritone hexatonic scale", "two-semitone tritone hexatonic scale", "whole tone scale"] . map Just $+          [h4 . filter (\(i,_) -> toneE i nL nL [0,2,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 .+           filter (\(i,_) -> toneE i nL nL [0,2,4,6,9,10]) . zip [0..] . sliceToList nL n2 $ notes, +            h4 . filter (\(i,_) -> toneE i nL nL [0,2,3,6,7,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,4,7,8,11]) . zip [0..] . sliceToList nL n2 $ notes, +              h4 . filter (\(i,_) -> toneE i nL nL [0,2,5,7,9]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,8,10]) . zip [0..] . sliceToList nL n2 $ notes, +                h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, +                  h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,5,7,9]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,7,9]) . zip [0..] . sliceToList nL n2 $ notes, +                    h4 . filter (\(i,_) -> toneE i nL nL [0,2,3,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, +                      h4 . filter (\(i,_) -> toneE i nL nL [0,1,4,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,1,3,7,8,9]) . zip [0..] . sliceToList nL n2 $ notes, +                        h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,6,8,10]) . zip [0..] . sliceToList nL n2 $ notes]) xs+ | otherwise = Nothing+filterInParams (P3sf nT nL n2 xs) + | all (>= 0) [101 - nL,nT,nL,nT - nL,nL + 6 - nT] && n2 == 6 = +    case xs of +      "Dorian tetrachord" -> +        if (nT - nL) `elem` [0,1,3,5] then Just (h4 . filter (\(i,_) -> toneE i nL nT [0,1,3,5]) . zip [0..] . sliceToList nL 6 $ notes) else Nothing+      "Phrygian tetrachord" -> +        if (nT - nL) `elem` [0,2,3,5] then Just (h4 . filter (\(i,_) -> toneE i nL nT [0,2,3,5]) . zip [0..] . sliceToList nL 6 $ notes) else Nothing+      "Lydian tetrachord" -> +        if (nT - nL) `elem` [0,2,4,5] then Just (h4 . filter (\(i,_) -> toneE i nL nT [0,2,4,5]) . zip [0..] . sliceToList nL 6 $ notes) else Nothing+      _   -> Nothing+ | all (>= 0) [94 - nL,nT,nL,nT - nL,nL + 13 - nT] && n2 == 13 = +    getBFstLSorted' Nothing (zip ["modern Aeolian mode", "modern Dorian mode", "modern Ionian mode", "modern Locrian mode", +      "modern Lydian mode", "modern Mixolydian mode", "modern Phrygian mode"] $ fmap (h3 nT n2 nL) [[1,4,6,9,11], [1,4,6,8,11], [1,3,6,8,10], +        [2,4,7,9,11], [1,3,5,8,10], [1,3,6,8,11], [2,4,6,9,11]]) xs+ | otherwise = Nothing++h3 :: Int -> Int -> Int -> [Int] -> Maybe (Array Int Float)+h3 nT n2 nL zs + | nT == nL = Just ((\rs -> listArray (0,length rs - 1) rs) . map snd . filter (\(i, _) -> toneD i nL nT zs) . zip [0..] . sliceToList nL n2 $ notes)+ | otherwise = Nothing++h4 :: [(a,b)] -> Array Int b+h4 = (\rs -> listArray (0,length rs - 1) rs) . map snd+{-# INLINE h4 #-}++-- | For the list of @a@ from the @Ord@ class it builds a sorted in the ascending order list without duplicates.+-- +-- > sortNoDup [2,1,4,5,6,78,7,7,5,4,3,2,5,4,2,4,54,3,5,65,4,3,54,56,43,5,2] = [1,2,3,4,5,6,7,43,54,56,65,78]+-- +sortNoDup :: Ord a => [a] -> [a]+sortNoDup = sortNoDup' . sort+  where sortNoDup' (x:x1@(y:_)) +         | x == y = sortNoDup' x1+         | otherwise = x:sortNoDup' x1+        sortNoDup' (x:_) = [x]+        sortNoDup' _ = []++-- | Checks whether its first 'Int' argument does not belong to those ones that are included into the list argument on the reminders basis. +-- The opposite to 'toneE' with the same arguments. The list argument must be sorted in the ascending order.+toneD :: Int -> Int -> Int -> [Int] -> Bool+toneD i nL nT zs = getBFstLSorted' True (zip zs . replicate 12 $ False) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12)++-- | Checks whether its first 'Int' argument does belong to those ones that are included into the list argument on the reminders basis. +-- The opposite to 'toneD' with the same arguments. The list argument must be sorted in the ascending order.+toneE :: Int -> Int -> Int -> [Int] -> Bool+toneE i nL nT zs = getBFstLSorted' False (zip zs . replicate 12 $ True) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12)++-- | Analogous to 'liftInEnku' lifts a frequency into a tonality (or something that can be treated alike one) specified by 'Params'. If not +-- reasonably one exists then the result is 11440 (Hz).+liftInParams :: Float -> Params -> Float+liftInParams x params + | lengthP params == 0 || (isNothing . whichOctaveG $ x) = 11440.0 + | otherwise =+    let !ys = map (abs . log . (\t -> t / x) . (\i ->+           unsafeAt notes (12 * fromJust (whichOctaveG x)) * 2 ** (fromIntegral i / fromIntegral (lengthP params))))+             [0..lengthP params - 1] in unsafeAt (fromJust . filterInParams $ params) (fromJust . elemIndex (minimum ys) $ ys)++-- | Application of the 'liftInParams' to a 'Array' 'Int'. +liftInParamsV :: Params -> [Float] -> [Float]+liftInParamsV params = filter (/= 11440.0) . map (\x -> liftInParams x params)++-- | Gets a length of the 'Array' 'Int' of 'Float' being represented as 'Params'. This is a number of the notes contained in the 'Params'.+lengthP :: Params -> Int+lengthP = fromMaybe 0 . fmap numElements . filterInParams++-- | Check whether a given 'Float' value (frequency of a note) is in the vector of Floats that corresponds to the given 'Params'.+elemP :: Float -> Params -> Bool+elemP note = fromMaybe False . fmap (note `F.elem`) . filterInParams++-- | Check whether a given 'Float' value (frequency of the closest note to the given frequency) is in the vector of Floats that +-- corresponds to the given 'Params'.+elemCloseP :: Float -> Params -> Bool+elemCloseP note = fromMaybe False . fmap (closestNote note `F.elem`) . filterInParams++-- | A way to show not the (somewhat algebraic) structure of the 'Params' (as the usual 'show' does), but the contained frequencies in it. +showD :: Params -> String+showD = show . filterInParams ++-- | Check whether for the given arguments there are the notes and whether 'String' is a name signature for the scale in 'Params' (can they be used +-- together to correspond to a non-empty set of notes).+isStrParams :: String -> Params -> Bool+isStrParams xs (P2s x y zs) = if isJust (filterInParams (P2s x y zs)) then xs == zs else False+isStrParams xs (P3sf x y z zs) = if isJust (filterInParams (P3sf x y z zs)) then xs == zs else False+isStrParams xs (P4lsf x y z ts zs) = if isJust (filterInParams (P4lsf x y z ts zs)) then xs == zs else False+isStrParams xs (P32sf x y z zs ys) = if isJust (filterInParams (P32sf x y z zs ys)) then (xs == zs || xs == ys || xs == (ys ++ " " ++ zs)) else False+isStrParams _ _ = False++-- | Check whether for the given arguments there are the notes and whether list of 'Int' is a part of the constructed 'Params' (can they be used +-- together to correspond to a non-empty set of notes).+isListParams :: [Int] -> Params -> Bool+isListParams xs (P4lsf x y z ts zs) = if isJust (filterInParams (P4lsf x y z ts zs)) then xs == ts else False+isListParams xs (P3lf x y zs) = if isJust (filterInParams (P3lf x y zs)) then xs == zs else False+isListParams _ _ = False++-- | Generates melody for the given parameters. The idea is that every application of the function @f :: Float -> OvertonesO@ to its argument +-- possibly can produce multiple overtones being represented as list of tuples of pairs of 'Float'. We can use the first element in the +-- tuple to obtain a new sound parameters and the second one -- to obtain its new duration in the melody. Additional function @g :: Float -> Float@ +-- is used to avoid the effect of becoming less and less -- closer to the zero for the higher overtones so the durations will become also less. +-- Besides it allows to rescale the durations in a much more convenient way. +-- +-- The first 'Float' parameter is a multiplication coefficient to increase or to decrease the durations (values with an absolute values greater than +-- one correspond to increasing inside the @g@. function applied afterwards with function composition and the values with an absolute values less +-- than one and not equal to zero correspond to decreasing inside the @g@ function. +-- The second 'Float' parameter is a usual frequency which is used instead of the 11440.0 (Hz) value. +-- The third 'Float' parameter is a main argument -- the frequency for which the 'OvertonesO' are generated as a first step of the computation. +overMeloPar :: (Float -> OvertonesO) -> (Float -> Float) -> Params -> Float -> Float -> Float -> IO ()+overMeloPar f g params coeff freq0 freq = do +  let v = f freq+      vFreqs = map ((\z -> if z == 11440.0 then freq0 else z) . flip liftInParams params . fst) v+      vD = map (g . (* coeff) . snd) v+      v2 = map f vFreqs+      vS = map (\z -> showFFloat (Just 4) (abs z) "") vD+      !l3 = length v2+      h42 j (x,v3,y,ts) +        | y > 0.0 = do +           (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing (fst x) ""] ""+           print herr+           partialTest_k1G v3 0 ts ((\rs -> listArray (0, l3 - 1) rs) . replicate l3 $ 0.0)+           mixTest+           renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav"+        | y < 0.0 = do +           (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"] "" +           putStr herr+           renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav"+        | otherwise = putStrLn "Zero length of the sound! " +  mapM_ (\(j, zz) -> h42 j zz) . zip [0..] . zip4 v v2 vD $ vS++-- | A default way to get 'Durations' for the sounds up to 0.35.2.0 version of the package including. It is based on the number of Ukrainian +-- sounds representations (see, 'convertToProperUkrainianS') in a Ukrainian syllables or somewhat generated by the same rules as they. +-- The rhythm using the function is very often not binary but its ratios are almost always a ratios of the small natural numbers (1, 2, 3, 4, 5, 6, 7 etc.).+str2DurationsDef :: Int -> String -> Float -> Durations+str2DurationsDef n zs y = +  let (!t, !ws) = splitAt 1 . syllableStr n $ zs+      !l = length ws - 1+        in amap (\yy -> y * fromIntegral (yy * length ws) / fromIntegral (head t)) . listArray (0,l) $ ws+  +apply6GSilentFile :: FilePath -> Float -> Float -> IO ()+apply6GSilentFile file limV vol = do+  upp <- upperBnd file+  ampL2 <- fmap ((\zz -> read zz::Float) . fst) (selMaxAbs file (0,upp))+  if abs ampL2 <= abs limV then putStr "" else apply6Gf vol file++-- | Apply volume adjustment to the sound file. It must not be silent. Otherwise, it leads to likely noise sounding or errors.+-- The code is adapted from the MMSyn7l module from the @mmsyn7l@ package.+apply6Gf :: Float -> FilePath -> IO ()+apply6Gf vol file = do+  (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) ([file,file ++ "effects" ++ efw2 file] ++ ["norm","vol", showFFloat (Just 4) vol ""]) ""+  case code of+    ExitSuccess -> renameFile (file ++ "effects" ++ efw2 file) file+    _ -> do+       removeFile $ file ++ "effects" ++ efw2 file+       putStrLn $ "MMSyn7l.soxE \"" ++ file ++ "\" has not been successful. The file has not been changed at all. "+     +-- | Function is used to generate a rhythm of the resulting file \'end.wav\' from the Ukrainian text and a number of sounds either in the syllables or in the words without vowels.+syllableStr :: Int -> String -> [Int]+syllableStr n xs =+  let ps = take n . cycle . concat . fmap (fmap (length)) . createSyllablesUkrS $ xs+      y  = sum ps in+       case y of+         0 -> [0]+         _ -> y:ps  ++-- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter.+-- For more information, please, refer to 'soxBasicParams'.+overSoXSynth2FDN_Sf32G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> Array Int Float -> String -> IO ()+overSoXSynth2FDN_Sf32G f (x, y, t0) j zs vdB ys+ | null . convertToProperUkrainianS $ zs = overSoXSynthG f x+ | otherwise = do+    let l0    = length zs+    soundGenF32G [\x2 -> closestNote (if x2 /= 0.0 then abs x2 else unsafeAt notes 0),\x2 -> fromMaybe (unsafeAt notes 0)+     (dNote (unsafeAt (intervalsFromString zs) (abs (j `rem` l0))) (closestNote (if x2 /= 0.0 then abs x2 else unsafeAt notes 0)))]+       (replicate 2 x) [1,unsafeAt (intervalsFromString zs) (abs (j `rem` l0))] f (x, y, t0) j vdB ys+    if null ys then mixTest else mixTest2G ys++-- | Function is used to get numbers of intervals from a Ukrainian 'String'. It is used internally in the 'uniqOverSoXSynthN4' function.+intervalsFromString :: String -> Intervals+intervalsFromString = vStrToVIntG defInt . convertToProperUkrainianS++-- | Generatlized version of the 'vStrToVInt' with a possibility to specify your own 'Intervals'.+vStrToVIntG :: Intervals -> String -> Intervals+vStrToVIntG v xs = listArray (0,l) . map (strToIntG v) $ xs+ where l = length xs - 1++-- | Default values for 'strToInt'. All the intervals are not greater than one full octave.+defInt :: Intervals+defInt = listArray (0,28) [5,3,7,11,1,12,4,11,4,12,2,9,3,12,5,10,7,7,7,12,10,7,10,2,12,7,2,12,8]+{-# INLINE defInt #-}++-- | Generatlized version of the 'strToInt' with a possibility to specify your own 'Intervals'.+strToIntG :: Intervals -> Char -> Int+strToIntG v =+  getBFstLSorted' 0 (zip "ABCEFabcdefghijklmnoprstuvxyz" . elems $ v)+{-# INLINE strToIntG #-}++-- | Generates a melodic line (a somewhat complex changing sound) with a possibility to specify sound quality using the 'String' argument. For more information,+-- please, refer to 'soxBasicParams'.+soundGenF32G :: [Float -> Float] -> [Float] -> [Int] -> (Float -> OvertonesO) -> (Float, Float, Float) -> Int ->+  Array Int Float -> String -> IO ()+soundGenF32G vf vd vi f (x, y, t0) j vdB ys = do+  let vD = helpF1 vf vd vi   +      vDz = mapMaybe id vD -- The previous one without Nothings and Justs+      vNotes = doubleVecFromVecOfFloat f t0 . map Just $ vDz+      ts = showFFloat (Just 4) (abs y) "" -- duration of the sound to be generated+  mapM_ (\(i, w, u, vv) -> do+    _ <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) (((\wwws -> adjust_dbVol wwws vv)) ["-r22050", "-n", "test" ++ helpF0 i ++ ".wav", "synth",ts,+         "sine", showFFloat Nothing w "","vol", if compare y 0.0 == GT then "1.0" else "0"])) ""+    partialTest_k2G u i ts vdB ys) . zip4 [0..] vDz vNotes . elems $ vdB++helpF0 :: Int -> String+helpF0 =+  getBFstLSorted' "ZZ0" (zip [0..] $ (map (:[]) "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ++ concatMap (\z -> map ((z:) . (:[])) "ABCDEFGHIJKLMNOPQRSTUVWXYZ")+     "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) ++helpF1 :: [Float -> Float] -> [Float] -> [Int] -> [Maybe Float]+helpF1 vf vd =+  map (\(f1,x,i2) ->+    case i2 of+      0 -> Nothing+      _ -> Just $ f1 x) . zip3 vf vd++-- | Generates a list of 'OvertonesO' that represents the melodic line. +doubleVecFromVecOfFloat :: (Float -> OvertonesO) -> Float -> [Maybe Float] -> [OvertonesO]+doubleVecFromVecOfFloat f t0 =+  map (\note1 -> if isNothing note1 then [] else filter (\(_,!z) -> compare (abs z) t0 == GT) . f . fromJust $ note1)
+ Composition/Sound/Functional/Split.hs view
@@ -0,0 +1,175 @@+-- |+-- Module      :  Composition.Sound.Functional.Split+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.Functional.Split (+  -- * Splitting and concatenating OvertonesO+  splitO+  , splitO2+  , overConcat+  -- ** Generalization of the previous ones splitting functions+  , splitHelp1+  , splitHelp2+  , splitOG1+  , splitOG2+  , splitOG12+  , splitOG12S+  , splitOG22+  , splitOG22S+) where++import CaseBi.Arr (getBFstL')+import Data.Char (isAsciiLower)+import Data.List (sortBy)+import GHC.Arr+import Data.Foldable.Ix+import qualified Data.Foldable as F+import Composition.Sound.Functional.Basics+++-- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number @n@ (specified by the first 'Int' argument) of 'OvertonesO' +-- (represented finally as a list of them respectively) so that all except the first @n@ greatest by the absolute value of the amplitude +-- tuples of Floats are considered overtones for the greatest by the absolute value one in the given 'OvertonesO' and all the next @n - 1@ +-- are treated as the greatest by the absolute value and each of them produces the similar by the @f :: Float -> OvertonesO@ function overtones.+-- +-- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar ones with different heights. +-- To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one.+splitO :: Int -> OvertonesO -> [OvertonesO]+splitO n v0 + | length v0 > (n + 1) = +    let v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        (x0, y0) = head v1+        v2 = s2L 1 (n - 1) v1+        v31 = map (\t -> (fst t) / x0) v2+        v32 = map (\t -> (snd t) / y0) v2+        v3 = zip v31 v32+        f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3+          in map f1Tup . take n $ v1+ | otherwise = [v0]++-- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number of 'OvertonesO' (represented finally as a 'Array' 'Int' of them repsectively) +-- so that it intermediately uses a special function before applying the \"similarization\" splitting function. Is a generalization of the 'splitO', +-- which can be considered a 'splitO2' with a first command line argument equals to 'id'.+-- +-- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar (less or more, depending on @h :: OvertonesO -> OvertonesO@) +-- ones with different heights. To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one.+splitO2 :: (OvertonesO -> OvertonesO) -> Int -> OvertonesO -> [OvertonesO]+splitO2 h n v0+ | length v0 > (n + 1) = +    let v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        (x0, y0) = head v1+        v2 = s2L 1 (n - 1) v1+        v31 = map (\t -> (fst t) / x0) v2+        v32 = map (\t -> (snd t) / y0) v2+        v3 = zip v31 v32+        f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3+          in map f1Tup (h . take n $ v1)+ | otherwise = [v0]++-- | Generalized variant of the 'splitO' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument.+splitOG1 :: String -> Int -> OvertonesO -> [OvertonesO]+splitOG1 xs n v0 + | length v0 > (n + 1) = +    let c1s = take 2 . filter isAsciiLower $ xs+        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        (x0, y0) = head v1 in+          case c1s of+            "ab" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,n - 1,length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) +            "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) +            "ad" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) +            _    -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + | otherwise = [v0]++-- | Auxiliary function that is used inside 'splitOG1'.+splitHelp1 :: Int -> Int -> Int -> Int -> [(Float, Float)] -> (Float,Float) -> [OvertonesO]+splitHelp1 x1 x2 x3 x4 v0 (y5,y6) = +  let v2 = s2L x1 x2 v0+      v31 = map (\t -> (fst t) / y5) v2+      v32 = map (\t -> (snd t) / y6) v2+      v3 = zip v31 v32+      f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3 in map f1Tup (s2L x3 x4 v0)++-- | Auxiliary function that is used inside 'splitOG2'.+splitHelp2 :: (OvertonesO -> OvertonesO) -> Int -> Int -> Int -> Int -> [(Float, Float)] -> (Float,Float) -> [OvertonesO]+splitHelp2 h1 x1 x2 x3 x4 v0 (y5,y6) = +  let v2 = s2L x1 x2 v0+      v31 = map (\t -> (fst t) / y5) v2+      v32 = map (\t -> (snd t) / y6) v2+      v3 = zip v31 v32+      f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3 in map f1Tup (h1 . s2L x3 x4 $ v0)        ++-- | Generalized variant of the 'splitO2' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument.+splitOG2 :: (OvertonesO -> OvertonesO) -> String -> Int -> [(Float, Float)] -> [OvertonesO]+splitOG2 h xs n v0+ | length v0 > (n + 1) = +    let c1s = take 2 . filter isAsciiLower $ xs+        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        (x0, y0) = head v1 in+          case c1s of+            "ab" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,n - 1,length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) +            "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) +            "ad" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) +            _    -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + | otherwise = [v0]++-- | Generalized variant of the 'splitOG1' with a possibility to specify a default value for splitting parameters as the first argument +-- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order list (the second one). +-- Each 'String' in the list must be unique and consist of lowercase ASCII letters.+splitOG12 :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> String -> Int -> [(Float, Float)] -> [OvertonesO]+splitOG12 (x1,x2,x3,x4) vf xs n v0+ | length v0 > (n + 1) && not (null vf) = +    let c1s = filter isAsciiLower xs+        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) vf) c1s in +          splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + | otherwise = [v0]    ++-- | Variant of the 'splitOG12' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument +-- then it is better to use 'splitOG12'. Each 'String' in the list must be unique and consist of lowercase ASCII letters.+splitOG12S :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> String -> Int -> [(Float, Float)] -> [OvertonesO]+splitOG12S (x1,x2,x3,x4) vf xs n v0+ | length v0 > (n + 1) && not (null vf) = +    let c1s = filter isAsciiLower xs+        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        v2 = sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) vf+        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) v2) c1s in +          splitHelp1 k1 k2 k3 k4 v1 (x0,y0) + | otherwise = [v0]++-- | Generalized variant of the 'splitOG2' with a possibility to specify a default value for splitting parameters as the first argument +-- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order list (the second one). +-- Each 'String' in the list must be unique and consist of lowercase ASCII letters.+splitOG22 :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> (OvertonesO -> OvertonesO) -> String -> Int -> +  [(Float, Float)] -> [OvertonesO]+splitOG22 (x1,x2,x3,x4) vf h xs n v0+ | length v0 > (n + 1) && not (null vf) = +    let c1s = filter isAsciiLower xs+        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) vf) c1s in +          splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + | otherwise = [v0]    + +-- | Variant of the 'splitOG22' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument +-- then it is better to use 'splitOG22'. Each 'String' in the list must be unique and consist of lowercase ASCII letters.+splitOG22S :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> (OvertonesO -> OvertonesO) -> String -> Int -> +  [(Float, Float)] -> [OvertonesO]+splitOG22S (x1,x2,x3,x4) vf h xs n v0+ | length v0 > (n + 1) && not (null vf) = +    let c1s = filter isAsciiLower xs+        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0+        v2 = sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) vf+        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) v2) c1s in +          splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) + | otherwise = [v0]    ++-- | Concatenates a list of 'OvertonesO' into a single 'OvertonesO'. Can be easily used with 'splitO'.+overConcat :: [OvertonesO] -> OvertonesO+overConcat = concat
+ Composition/Sound/IntermediateF.hs view
@@ -0,0 +1,747 @@+-- |+-- 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+  +
+ Composition/Sound/Keyboard.hs view
@@ -0,0 +1,143 @@+-- |+-- Module      :  Composition.Sound.Keyboard+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.Keyboard (+  -- * Working with input and files+  qwerty2dvorak+  , dvorak2qwerty+  , input2BL+  , input2BLN+  , input2BLMN+  , readFile2BL+  , readFile2BLN+  , readFile2BLMN+  , readFile2BLGen  +  , readFile2BLGenN+  , readFile2BLGenMN+  -- * Conversions+  , readFileDoubles+  , readFileDoublesN+  , readFileDoublesMN+  , readFileDoublesGen+  , readFileDoublesGenN+  , readFileDoublesGenMN+  , takeDoubles+  , hashStr2+  , convH+) where++import CaseBi.Arr (getBFstL',getBFstLSorted')+import Data.Char (isAsciiLower)+import GHC.Arr+import Data.Foldable.Ix+import GHC.Int (Int64)+import qualified Data.ByteString.Lazy.Char8 as BL (ByteString,map,zipWith,tail,filter,getContents,readFile,take,drop)++-- | Converts a lazy 'BL.ByteString' into a list of 'Int' using 'hashStr2'. +takeDoubles :: BL.ByteString -> [Int]+takeDoubles xs = BL.zipWith hashStr2 xs $ BL.tail xs++-- | Converts a string of lowercase ASCII letters being typed on the QWERTY keyboard layout into corresponding Dvorak keyboard layout.+qwerty2dvorak :: BL.ByteString -> BL.ByteString+qwerty2dvorak = BL.map (getBFstL' ' ' (zip ("/;<>" ++ ['a'..'z']) "wvszaxje.uidchtnmbrl'poygk,qf;"))++-- | Vice versa to 'qwerty2dvorak'.+dvorak2qwerty :: BL.ByteString -> BL.ByteString+dvorak2qwerty = BL.map (getBFstL' ' ' (zip ("',.;" ++ ['a'..'z']) "qwezanihdyujgcvpmlsrxo;kf.,bt/"))++-- | Hashes two lower case ascii characters. Is used for controlling frequencies and operators.+hashStr2 :: Char -> Char -> Int+hashStr2 x y = getBFstLSorted' 57 (zip ['a'..'z'] . map (\t -> getBFstLSorted' (26 * t + 18) (zip ['a'..'z'] [(26 * t + 4)..]) y) . +  concat $ [[0],[6..8],[1],[9..11],[4],[12..16],[2],[17..21],[3],[22..24],[5,25]]) x -- 679 is the greatest value ~ \"zz\"; there are 572 effectful val.++-- | Get contents into lazy 'BL.ByteString' with filtering of all characters that are not a lower case ascii letters.+input2BL :: IO (BL.ByteString)+input2BL = fmap (convH [] (BL.filter isAsciiLower)) BL.getContents++-- | Like 'input2BL', but takes only first @n@ symbols specified with the first 'Int64' argument.+input2BLN :: Int64 -> IO (BL.ByteString)+input2BLN n = fmap (convH [] (BL.take n . BL.filter isAsciiLower)) BL.getContents++-- | Like 'input2BL', but takes only first @n@ symbols specified with the second 'Int64' argument dropping before this the first @m@ symbols specified +-- with the first 'Int64' argument.+input2BLMN :: Int64 -> Int64 -> IO (BL.ByteString)+input2BLMN m n = fmap (convH [] (BL.take n . BL.drop m . BL.filter isAsciiLower)) BL.getContents++-- | Reads a given file into a lazy 'BL.ByteString' with filtering of all characters that are not a lower case ascii letters. It has additional +-- first command line argument to control the way of treating letters: as being typed (entered) properly (null 'String'), or needed to be converted +-- from qwerty to dvorak layout (\"q\" 'String'), or vice versa (otherwise).+readFile2BLGen :: String -> FilePath -> IO (BL.ByteString)+readFile2BLGen ys = fmap (convH ys (BL.filter isAsciiLower)) . BL.readFile++-- | Like 'readFile2BLGen', but reads only first @n@ symbols specified with the first 'Int64' argument.+readFile2BLGenN :: Int64 -> String -> FilePath -> IO (BL.ByteString)+readFile2BLGenN n ys = fmap (convH ys (BL.take n . BL.filter isAsciiLower)) . BL.readFile++-- | Like 'readFile2BLGen', but reads only first @n@ symbols specified with the second 'Int64' argument dropping before this the first @m@ symbols specified +-- with the first 'Int64' argument.+readFile2BLGenMN :: Int64 -> Int64 -> String -> FilePath -> IO (BL.ByteString)+readFile2BLGenMN m n ys = fmap (convH ys (BL.take n . BL.drop m . BL.filter isAsciiLower)) . BL.readFile++-- | Auxiliary function to define how is a 'BL.ByteString' treated, see 'readFile2BLGen'.+convH :: String -> (BL.ByteString -> BL.ByteString) -> (BL.ByteString -> BL.ByteString)+convH ys f + | null ys = f+ | ys == "q" = qwerty2dvorak . f+ | otherwise = dvorak2qwerty . f+  +-- | Usual way the function 'readFile2BLGen' is used. The text in a file being read is treated as a properly typed (entered) one. So there is no +-- keyboard layout conversion at all.+readFile2BL :: FilePath -> IO (BL.ByteString)+readFile2BL = readFile2BLGen []+{-# INLINE readFile2BL #-}++-- | Like 'readFile2BL', but reads only first @n@ symbols specified with the first 'Int64' argument.+readFile2BLN :: Int64 -> FilePath -> IO (BL.ByteString)+readFile2BLN n = readFile2BLGenN n []+{-# INLINE readFile2BLN #-}++-- | Like 'readFile2BL', but reads only first @n@ symbols specified with the second 'Int64' argument dropping before this the first @m@ symbols specified +-- with the first 'Int64' argument.+readFile2BLMN :: Int64 -> Int64 -> FilePath -> IO (BL.ByteString)+readFile2BLMN m n = readFile2BLGenMN m n []+{-# INLINE readFile2BLMN #-}++-- | After reading a file into a filtered lazy 'BL.ByteString' (see, 'readFile2BLGen') converts the resulting 'BL.ByteString' into a list+-- of 'Int'. The arguments have the same meaning as for 'readFile2BLGen'.+readFileDoublesGen :: String -> FilePath -> IO [Int]+readFileDoublesGen ys = fmap (takeDoubles . convH ys (BL.filter isAsciiLower)) . BL.readFile++-- | Like 'readFileDoublesGen', but returns only first @n@ elements of the list specified with the first 'Int64' argument.+readFileDoublesGenN :: Int64 -> String -> FilePath -> IO [Int]+readFileDoublesGenN n ys = fmap (take (fromIntegral n) . takeDoubles . convH ys (BL.filter isAsciiLower)) . BL.readFile++-- | Like 'readFileDoublesGen', but returns only first @n@ symbols specified with the second 'Int64' argument dropping before this the first @m@ symbols specified +-- with the first 'Int64' argument.+readFileDoublesGenMN :: Int64 -> Int64 -> String -> FilePath -> IO [Int]+readFileDoublesGenMN m n ys = fmap (s2L (fromIntegral m) (fromIntegral n) . takeDoubles . convH ys (BL.filter isAsciiLower)) . BL.readFile++-- | Usual way the function 'readFileDoublesGen' is used. The text in a file being read is treated as a properly typed (entered) one. So there is no +-- keyboard layout conversion at all.+readFileDoubles :: FilePath -> IO [Int]+readFileDoubles = readFileDoublesGen []+{-# INLINE readFileDoubles #-}++-- | Like 'readFileDoubles', but returns only first @n@ elements of the list specified with the first 'Int64' argument.+readFileDoublesN :: Int64 -> FilePath -> IO [Int]+readFileDoublesN n = readFileDoublesGenN n []+{-# INLINE readFileDoublesN #-}++-- | Like 'readFileDoubles', but returns only first @n@ elements of the list specified with the second 'Int64' argument +-- dropping before this the first @m@ elements specified with the first 'Int64' argument.+readFileDoublesMN :: Int64 -> Int64 -> FilePath -> IO [Int]+readFileDoublesMN m n = readFileDoublesGenMN m n []+{-# INLINE readFileDoublesMN #-}
+ Composition/Sound/Octaves.hs view
@@ -0,0 +1,66 @@+-- |+-- Module      :  Composition.Sound.Octaves+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.Octaves (+  -- * Work with octaves+  octaveUp+  , octaveDown+  , liftInOctave+  , liftInOctaveV+) where++import Data.Maybe (fromJust, mapMaybe)+--import qualified Data.Vector as V+import GHC.Arr+import GHC.List (iterate')+import Data.List hiding (iterate')+import Composition.Sound.Functional.Basics++-- | Returns an analogous note in the higher octave (its frequency in Hz).+octaveUp :: Float -> Float+octaveUp x = 2 * x+{-# INLINE octaveUp #-}++-- | Returns an analogous note in the lower octave (its frequency in Hz).+octaveDown :: Float -> Float+octaveDown x = x / 2+{-# INLINE octaveDown #-}++-- | Function lifts the given frequency to the given number of the octave (in American notation, from 0 to 8). This number is an 'Int' parameter.+-- The function also takes into account the lower pure quint for the closest note.+-- If it is not practical to determine the number, then the function returns 'Nothing'.+liftInOctave :: Int -> Float -> Maybe Float+liftInOctave n x+  | n < 0 || n > 8 = Nothing+  | closestNote x > 24.4996 =+      case compare (fromJust . whichOctave $ x) n of+        EQ -> Just (closestNote x)+        LT -> let z  = logBase 2.0 (unsafeAt notes (n * 12) / closestNote x)+                  z1 = truncate z in+                   if abs (z - fromIntegral z1) > 0.999 || abs (z - fromIntegral z1) < 0.001+                     then Just (last . take (fromIntegral z1 + 1) . iterate' octaveUp $ closestNote x)+                     else Just (last . take (fromIntegral z1 + 2) . iterate' octaveUp $ closestNote x)+        _  -> let z  = logBase 2.0 (closestNote x / unsafeAt notes (n * 12))+                  z1 = truncate z in+                   if abs (z - fromIntegral z1) > 0.999 || abs (z - fromIntegral z1) < 0.001+                     then Just (last . take (fromIntegral z1 + 2) . iterate' octaveDown $ closestNote x)+                     else Just (last . take (fromIntegral z1 + 1) . iterate' octaveDown $ closestNote x)+  | otherwise = Nothing++-- | Function lifts the list of 'Float' representing frequencies to the given octave with the 'Int' number. Better to use numbers in the range [1..8].+-- The function also takes into account the lower pure quint for the obtained note behaviour. If it is not practical to determine the octave, the resulting+-- frequency is omitted from the resulting list.+liftInOctaveV :: Int -> [Float] -> [Float]+liftInOctaveV n = mapMaybe (liftInOctave n)++--------------------------------------------------------------------------------------------------------------------------------+
+ Composition/Sound/Overtones.hs view
@@ -0,0 +1,655 @@+-- |+-- Module      :  Composition.Sound.Overtones+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.++{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -threaded #-}++module Composition.Sound.Overtones (+  -- * Library and executable functions+  -- ** For the fixed timbre+  overSoXSynthN+  -- *** For the fixed timbre with different signs for harmonics coefficients+  , overTones2+  , overSoXSynth2+  , overSoXSynthN2+  , overSoXSynthN3+  -- *** Use additional parameters+  , overSoXSynthDN+  , overSoXSynth2DN+  -- *** Use a file for information+  , overSoXSynthNGen+  , overSoXSynthNGen2+  , overSoXSynthNGen3+  -- * Extended generation using enky functionality+  -- ** With somewhat fixed timbre+  , overSoXSynthNGenE+  , overSoXSynthNGen2E+  , overSoXSynthNGen3E+  -- * New 4G functions to work with Durations+  , overSoXSynthN4G+  , overSoXSynthN24G+  , overSoXSynthN34G+  , overSoXSynthNGenE4G+  , overSoXSynthNGen2E4G+  , overSoXSynthNGen3E4G+  -- ** 4G with speech-like composition+  , overSoXSynthN4GS+  , overSoXSynthN24GS+  , overSoXSynthN34GS+  , overSoXSynthNGenE4GS+  , overSoXSynthNGen2E4GS+  , overSoXSynthNGen3E4GS+  -- * New 5G functions to work also with Intervals+  , overSoXSynthN35G+  , overSoXSynthNGen3E5G+  -- ** 5G with obtained from the text arbitraty length Intervals+  , overSoXSynthN35GS+  , overSoXSynthNGen3E5GS+  -- * New 6G function to work also with Strengths+  , overSoXSynthNGen3E6G+  -- ** 6G with obtained from the text arbitrary length Strengths+  , overSoXSynthNGen3E6GS+  , overSoXSynthNGen3E6GSu+  -- * New generalized functions working with Params+  , overSoXSynthNGenEPar+  , overSoXSynthNGenE4GSPar+  , overSoXSynthNGenE4GPar+  , overSoXSynthNGen2EPar+  , overSoXSynthNGen2E4GSPar+  , overSoXSynthNGen2E4GPar+  , overSoXSynthNGen3EPar+  , overSoXSynthNGen3E4GSPar+  , overSoXSynthNGen3E4GPar+  , overSoXSynthNGen3E5GPar+  , overSoXSynthNGen3E5GSPar+  , overSoXSynthNGen3E6GPar+  , overSoXSynthNGen3E6GSPar+  , overSoXSynthNGen3E6GSuPar+) where++import Numeric (showFFloat)+import Data.List (isPrefixOf,sort)+import Data.Maybe (isNothing,fromJust,maybe)+--import qualified Data.Vector as V+import GHC.Arr+import qualified Data.Foldable as F+import System.Process+import EndOfExe (showE)+import System.Directory+import Melodics.ByteString.Ukrainian.Arr (convertToProperUkrainianS)+import Composition.Sound.Functional.Basics+import Composition.Sound.Functional.Params+import Composition.Sound.DIS5G6G++-- | For the given frequency of the note and a Ukrainian text it generates a list of the tuples, each one of which contains+-- the harmonics' frequency and amplitude. The 'String' is used to produce the signs for harmonics coefficients.+overTones2 :: Float -> String -> OvertonesO+overTones2 note ts =+  takeWhile (\(!w,!z) -> w <= unsafeAt notes 107 && abs z > 0.001) . filter (\(_, t4) -> t4 /= 0.0) .+    map (\i -> (note * fromIntegral (i + 2), fromIntegral (unsafeAt (signsFromString 1024 ts)+      (i + 1)) / fromIntegral ((i + 1) * (i + 1)))) $ [0..1023]++-- | Similar to 'overSoXSynth' except that takes not necessarily pure lower quint note as the second one, but the one specified by the 'String' parameter+-- as an argument to 'dNote'. If you begin the 'String' with space characters, or \"сь\", or \"ць\", or dash, or apostrophe, or soft sign, than there will+-- be no interval and the sound will be solely one with its 'OvertonesO'.+overSoXSynthDN :: Float -> String -> IO ()+overSoXSynthDN x = overSoXSynth2DN x 0.5+{-# INLINE overSoXSynthDN #-}++overSoXSynthHelp :: OvertonesO -> IO ()+overSoXSynthHelp = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+        ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN "",+           "vol", showFFloat (Just 4) amplN ""] "") . zip [0..]++overSoXSynthHelp2 :: OvertonesO -> IO ()+overSoXSynthHelp2 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+        ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN "",+           "vol", showFFloat (Just 4) amplN ""] "") . zip [0..]++-- | Similar to 'overSoXSynthDN' except that the resulting duration is specified by the second 'Float' parameter in seconds. For 'overSoXSynthDN'+-- it is equal to 0.5.+overSoXSynth2DN :: Float -> Float -> String -> IO ()+overSoXSynth2DN x y zs+ | null . convertToProperUkrainianS $ zs = overSoXSynth x+ | otherwise = do+    let note0 = closestNote x+        note1 = dNote (unsafeAt (intervalsFromString zs) 0) note0+        v0    = overTones note0+        v1    = maybe [] overTones note1+    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y "","sine",+       showFFloat (Just 4) note0 "", "vol","0.5"] ""+    if isNothing note1 then overSoXSynthHelp v0+    else do +      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y "","sine",+         showFFloat (Just 4) (fromJust note1) "", "vol","0.5"] ""+      overSoXSynthHelp v0+      overSoXSynthHelp2 v1+    mixTest++-- | 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*\" files in the current directory, because they can be overwritten.+-- The 'String' argument is used to define signs of the harmonics coefficients for Overtones.+overSoXSynth2 :: Float -> String -> IO ()+overSoXSynth2 x tts = do+  let note0 = closestNote x+      note1 = pureQuintNote note0+      v0    = overTones2 note0 tts+      v1    = overTones2 note1 tts+  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test01.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 "",+     "synth", "0.5","sine", "mix", showFFloat (Just 4) note1 "", "vol","0.5"] ""+  overSoXSynthHelp v0+  overSoXSynthHelp2 v1+  mixTest ++-- | Function to create a melody for the given arguments. 'String' is used to provide a rhythm. 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. The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude+-- for Overtones. If it is set to 1.0 the overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results+-- in their becoming more silent ones. The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.+overSoXSynthN :: Int -> Float -> Float -> String -> [Float] -> IO ()+overSoXSynthN n ampL time3 zs = overSoXSynthN4G n ampL (str2DurationsDef n zs time3)+{-# INLINE overSoXSynthN #-}++overSoXSynthHelpN :: Int -> Int -> Int -> Float -> Durations -> OvertonesO -> IO ()+overSoXSynthHelpN j m zeroN ampL v21 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+  ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+    "sine",showFFloat (Just 4) noteN "", "vol", if (unsafeAt v21 (j `rem` m)) > 0.0+      then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]++overSoXSynthHelpN2 :: Int -> Int -> Int -> Float -> Durations -> OvertonesO -> IO ()+overSoXSynthHelpN2 j m zeroN ampL v21 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+  ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+     "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]++soxSynthHelpMain j m zeroN v21 note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n",+  "testA" ++ prependZeroes zeroN "1" ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine",+    showFFloat (Just 4) note01 "", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", "mix",+      showFFloat (Just 4) note02 "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then "0.5" else "0"] ""++-- | Function to create a melody for the given arguments. 'Durations' is used to provide a rhythm. +overSoXSynthN4G :: Int -> Float -> Durations -> [Float] -> IO ()+overSoXSynthN4G n ampL v2 vec0+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Overtones.overSoXSynthN4G: You provided no valid durations data! "+ | abs ampL >= 0.01 && abs ampL <= 1.0 = +    let zeroN = numVZeroesPre vec0+        v21 = (\rs -> listArray (0,length rs -1) rs) . filter (/=0.0) . elems $ v2+        m = numElements v2 in mapM_ (\(j, x) -> do +          let note0 = closestNote x                     -- zs is obtained from the command line arguments+              note1 = pureQuintNote note0+              v0    = overTones note0+              v1    = overTones note1+          _ <- soxSynthHelpMain j m zeroN v21 note0 note1+          overSoXSynthHelpN j m zeroN ampL v21 v0+          overSoXSynthHelpN2 j m zeroN ampL v21 v1+          mixTest2 zeroN j) . zip [0..] $ vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then overSoXSynthN4G n 0.01 v2 vec0+    else overSoXSynthN4G n ampL1 v2 vec0++-- | Variant of the 'overSoXSynthN4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+overSoXSynthN4GS :: Int -> Float -> Float -> String -> [Float] -> IO ()+overSoXSynthN4GS n ampL time3 zs = overSoXSynthN4G n ampL (str2Durations zs time3)+{-# INLINE overSoXSynthN4GS #-}++-- | Function to create a melody for the given arguments. 'String' is used to provide a rhythm. 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. The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude+-- for Overtones. If it is set to 1.0 the overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results+-- in their becoming more silent ones. The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.+overSoXSynthN2 :: Int -> Float -> Float -> String -> String -> [Float] -> IO ()+overSoXSynthN2 n ampL time3 zs = overSoXSynthN24G n ampL (str2DurationsDef n zs time3)+{-# INLINE overSoXSynthN2 #-}+ +-- | Function to create a melody for the given arguments. 'Durations' is used to provide a rhythm. +overSoXSynthN24G :: Int -> Float -> Durations -> String -> [Float] -> IO ()+overSoXSynthN24G n ampL v2 tts vec0+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Overtones.overSoXSynthN24G: You provided no valid durations data! "+ | abs ampL >= 0.01 && abs ampL <= 1.0 = +    let v21 = (\rs -> listArray (0,length rs - 1) rs) . filter (/= 0.0) . elems $ v2+        zeroN = numVZeroesPre vec0+        m = length v21 in mapM_ (\(j, x) -> do +          let note0 = closestNote x                     -- zs is obtained from the command line arguments+              note1 = pureQuintNote note0+              v0    = overTones2 note0 tts+              v1    = overTones2 note1 tts+          _ <- soxSynthHelpMain j m zeroN v21 note0 note1+          overSoXSynthHelpN j m zeroN ampL v21 v0+          overSoXSynthHelpN2 j m zeroN ampL v21 v1+          mixTest2 zeroN j) . zip [0..] $ vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then overSoXSynthN24G n 0.01 v2 tts vec0+    else overSoXSynthN24G n ampL1 v2 tts vec0        ++-- | Variant of the 'overSoXSynthN24G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+overSoXSynthN24GS :: Int -> Float -> Float -> String -> String -> [Float] -> IO ()+overSoXSynthN24GS n ampL time3 zs = overSoXSynthN24G n ampL (str2Durations zs time3)+{-# INLINE overSoXSynthN24GS #-}++-- | Function to create a melody for the given arguments. 'String' is used to provide a rhythm. 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. The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude+-- for Overtones. If it is set to 1.0 the overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results+-- in their becoming more silent ones. The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.+-- The third 'String' argument is used to define the intervals for the notes if any.+-- The third 'Float' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of+-- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones.+-- The last one is experimental feature.+overSoXSynthN3 :: Int -> Float -> Float -> Float -> String -> String -> String -> [Float] -> IO ()+overSoXSynthN3 n ampL time3 dAmpl zs = overSoXSynthN34G n ampL dAmpl (str2DurationsDef n zs time3)+{-# INLINE overSoXSynthN3 #-}++-- | Function to create a melody for the given arguments. 'Duraitons' is used to provide a rhythm. +overSoXSynthN34G :: Int -> Float -> Float -> Durations -> String -> String -> [Float] -> IO ()+overSoXSynthN34G n ampL dAmpl v2 tts vs vec0+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Overtones.overSoXSynthN34G: You provided no valid durations data! "+ | abs ampL >= 0.01 && abs ampL <= 1.0 = +    let v21 = (\rs -> listArray (0,length rs -1) rs) . filter (/= 0.0) . elems $ v2+        m     = length v21+        zeroN = numVZeroesPre vec0+        v3    = intervalsFromString vs+        l     = length vs in mapM_ (\(j, x) -> do +          let note0 = closestNote x                     -- zs is obtained from the command line arguments+              note1 = dNote (unsafeAt v3 (j `rem` l)) note0+              v0    = overTones2 note0 tts+              v1    = if isNothing note1 then []+                      else overTones2 (fromJust note1) tts+              overSoXSynthHelpN1 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                  "sine",showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]+              overSoXSynthHelpN22 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                   "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (if dAmpl * amplN * ampL > 1.0 then 1.0+                     else dAmpl * amplN * ampL) "" else "0"] "") . zip [0..]+              soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++  ".wav",+                "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "vol",+                  if unsafeAt v21 (j `rem` m) > 0.0 then "0.5" else "0"] ""+              soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" +++                 prependZeroes zeroN "1" ++  ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note02 "",+                   "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / 2) "" else "0"] ""+          if isNothing note1 then do { _ <- soxSynthHelpMain0 note0+                                     ; overSoXSynthHelpN1 v0 }+          else do { _ <- soxSynthHelpMain0 note0+                  ; _ <- soxSynthHelpMain1 (fromJust note1)+                  ; overSoXSynthHelpN1 v0+                  ; overSoXSynthHelpN22 v1}+          paths0 <- listDirectory "."+          let paths = sort . filter (isPrefixOf "test") $ paths0+          _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result0" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) ""+          mapM_ removeFile paths) . zip [0..] $ vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then overSoXSynthN34G n 0.01 dAmpl v2 tts vs vec0+    else overSoXSynthN34G n ampL1 dAmpl v2 tts vs vec0++-- | Generalized variant of the 'overSoXSynthN34G' where you specify your own 'Intervals'. For more information, please, refer to 'intervalsFromStringG'.+overSoXSynthN35G :: Int -> Float -> Float -> Durations -> String -> Intervals -> [Float] -> IO ()+overSoXSynthN35G n ampL dAmpl v2 tts v3 vec0+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Overtones.overSoXSynthN35G: You provided no valid durations data! "+ | abs ampL >= 0.01 && abs ampL <= 1.0 = +    let v21 = (\rs -> listArray (0,length rs - 1) rs) . filter (/=0.0) . elems $ v2+        m     = length v21+        zeroN = numVZeroesPre vec0+        l     = numElements v3 in mapM_ (\(j, x) -> do +          let note0 = closestNote x                     -- zs is obtained from the command line arguments+              note1 = dNote (unsafeAt v3 (j `rem` l)) note0+              v0    = overTones2 note0 tts+              v1    = if isNothing note1 then []+                      else overTones2 (fromJust note1) tts+              overSoXSynthHelpN1 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                  "sine",showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]+              overSoXSynthHelpN22 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                   "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (if dAmpl * amplN * ampL > 1.0 then 1.0+                     else dAmpl * amplN * ampL) "" else "0"] "") . zip [0..]+              soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" ++ prependZeroes zeroN "1" ++  ".wav",+                "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "vol",+                  if unsafeAt v21 (j `rem` m) > 0.0 then "0.5" else "0"] ""+              soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" +++                 prependZeroes zeroN "1" ++  ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note02 "",+                   "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / 2) "" else "0"] ""+          if isNothing note1 then do { _ <- soxSynthHelpMain0 note0+                                     ; overSoXSynthHelpN1 v0 }+          else do { _ <- soxSynthHelpMain0 note0+                  ; _ <- soxSynthHelpMain1 (fromJust note1)+                  ; overSoXSynthHelpN1 v0+                  ; overSoXSynthHelpN22 v1}+          paths0 <- listDirectory "."+          let paths = sort . filter (isPrefixOf "test") $ paths0+          _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result0" ++ prependZeroes zeroN (show j) ++ ".wav","vol","0.3"]) ""+          mapM_ removeFile paths) . zip [0..] $ vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then overSoXSynthN35G n 0.01 dAmpl v2 tts v3 vec0+    else overSoXSynthN35G n ampL1 dAmpl v2 tts v3 vec0++-- | Variant of the 'overSoXSynthN34G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+overSoXSynthN34GS :: Int -> Float -> Float -> Float -> String -> String -> String -> [Float] -> IO ()+overSoXSynthN34GS n ampL time3 dAmpl zs = overSoXSynthN34G n ampL dAmpl (str2Durations zs time3)+{-# INLINE overSoXSynthN34GS #-}++-- | Variant of the 'overSoXSynthN34G' where intervals are obtained from the basic 'Intervals' with the length no more than 29 and a Ukrainian text +-- specified as the last 'String' argument so that you can produce 'Intervals' of the arbitrary length. For more information, please, refer to +-- 'intervalsFromStringG' and 'strToIntG'.+overSoXSynthN35GS :: Int -> Float -> Float -> Float -> String -> String -> Intervals -> String -> [Float] -> IO ()+overSoXSynthN35GS n ampL time3 dAmpl zs tts v3 vs = overSoXSynthN35G n ampL dAmpl (str2Durations zs time3) tts (intervalsFromStringG v3 vs)+{-# INLINE overSoXSynthN35GS #-}++-- | Similar to 'overSoXSynthN', but uses a sound file to obtain the information analogous to list in the latter one. Besides, the function lifts+-- the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). The first 'Float' argument from+-- the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the overTones amplitudes are just maximum ones,+-- otherwise they are multiplied by the parameter and this results in their becoming more silent ones.+-- The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). 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.+--+-- For better usage the 'FilePath' should be a filepath for the .wav file.+overSoXSynthNGen :: FilePath -> Int -> Float -> Float -> String -> IO ()+overSoXSynthNGen file m = overSoXSynthNGenE file m 12+{-# INLINE overSoXSynthNGen #-}+  +-- | Similar to 'overSoXSynthNGen', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained+-- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'overSoXSynthNGen'. To obtain+-- its modifications, please, use 2, 3, 4, 6, or 9.+overSoXSynthNGenE :: FilePath -> Int -> Int -> Float -> Float -> String -> IO ()+overSoXSynthNGenE file m ku ampL time3 zs = do+  n <- duration1000 file+  nGenE4Gi n file m ku ampL (str2DurationsDef n zs time3)++-- | Generalized version of the 'overSoXSynthNGenE' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGenEPar :: FilePath -> Params -> Float -> Float -> String -> IO ()+overSoXSynthNGenEPar file params ampL time3 zs = do+  n <- duration1000 file+  nGenE4GiPar n file params ampL (str2DurationsDef n zs time3)++-- | Variant of the 'overSoXSynthNGenE4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+overSoXSynthNGenE4GS :: FilePath -> Int -> Int -> Float -> Float -> String -> IO ()+overSoXSynthNGenE4GS file m ku ampL time3 zs = do+  n <- duration1000 file+  nGenE4Gi n file m ku ampL (str2Durations zs time3)++-- | Generalized version of the 'overSoXSynthNGenE4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGenE4GSPar :: FilePath -> Params -> Float -> Float -> String -> IO ()+overSoXSynthNGenE4GSPar file params ampL time3 zs = do+  n <- duration1000 file+  nGenE4GiPar n file params ampL (str2Durations zs time3)  ++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+nGenE4Gi :: Int -> FilePath -> Int -> Int -> Float -> Durations -> IO ()+nGenE4Gi n file m ku ampL v2 = do+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  overSoXSynthN4G n ampL v2 vecB+  endFromResult  +    +-- | Generalized version of the 'nGenE4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+nGenE4GiPar :: Int -> FilePath -> Params -> Float -> Durations -> IO ()+nGenE4GiPar n file params ampL v2 = do+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  overSoXSynthN4G n ampL v2 vecB+  endFromResult      +       +-- | 4G genaralized version of the 'overSoXSynthNGenE' where you provide your own 'Durations'.+overSoXSynthNGenE4G :: FilePath -> Int -> Int -> Float -> Durations -> IO ()+overSoXSynthNGenE4G file m ku ampL v2 = do+  n <- duration1000 file+  nGenE4Gi n file m ku ampL v2++-- | Generalized version of the 'overSoXSynthNGenE4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGenE4GPar :: FilePath -> Params -> Float -> Durations -> IO ()+overSoXSynthNGenE4GPar file params ampL v2 = do+  n <- duration1000 file+  nGenE4GiPar n file params ampL v2  ++-- | Similar to 'overSoXSynthN2', but uses a sound file to obtain the information analogous to list in the latter one. Besides, the function lifts+-- the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). The first 'Float' argument from+-- the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the overTones amplitudes are just maximum ones,+-- otherwise they are multiplied by the parameter and this results in their becoming more silent ones.+-- The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). 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.+-- +-- For better usage the 'FilePath' should be a filepath for the .wav file.+-- The second 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.+overSoXSynthNGen2 :: FilePath -> Int -> Float -> Float -> String -> String -> IO ()+overSoXSynthNGen2 file m = overSoXSynthNGen2E file m 12+{-# INLINE overSoXSynthNGen2 #-}+  +-- | Similar to 'overSoXSynthNGen2', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained+-- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'overSoXSynthNGen2'. To obtain+-- its modifications, please, use 2, 3, 4, 6, or 9.+overSoXSynthNGen2E :: FilePath -> Int -> Int -> Float -> Float -> String -> String -> IO ()+overSoXSynthNGen2E file m ku ampL time3 zs tts = do+  n <- duration1000 file+  nGen2E4Gi n file m ku ampL (str2DurationsDef n zs time3) tts++-- | Generalized version of the 'overSoXSynthNGen2E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen2EPar :: FilePath -> Params -> Float -> Float -> String -> String -> IO ()+overSoXSynthNGen2EPar file params ampL time3 zs tts = do+  n <- duration1000 file+  nGen2E4GiPar n file params ampL (str2DurationsDef n zs time3) tts  ++-- | Variant of the 'overSoXSynthNGen2E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+overSoXSynthNGen2E4GS :: FilePath -> Int -> Int -> Float -> Float -> String -> String -> IO ()+overSoXSynthNGen2E4GS file m ku ampL time3 zs tts = do+  n <- duration1000 file+  nGen2E4Gi n file m ku ampL (str2Durations zs time3) tts++-- | Generalized version of the 'overSoXSynthNGen2E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen2E4GSPar :: FilePath -> Params -> Float -> Float -> String -> String -> IO ()+overSoXSynthNGen2E4GSPar file params ampL time3 zs tts = do+  n <- duration1000 file+  nGen2E4GiPar n file params ampL (str2Durations zs time3) tts++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+nGen2E4Gi :: Int -> FilePath -> Int -> Int -> Float -> Durations -> String -> IO ()+nGen2E4Gi n file m ku ampL v2 tts = do+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  overSoXSynthN24G n ampL v2 tts vecB+  endFromResult ++-- | Generalized version of the 'nGen2E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+nGen2E4GiPar :: Int -> FilePath -> Params -> Float -> Durations -> String -> IO ()+nGen2E4GiPar n file params ampL v2 tts = do+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  overSoXSynthN24G n ampL v2 tts vecB+  endFromResult   +       +-- | 4G genaralized version of the 'overSoXSynthNGen2E' where you provide your own 'Durations'.+overSoXSynthNGen2E4G :: FilePath -> Int -> Int -> Float -> Durations -> String -> IO ()+overSoXSynthNGen2E4G file m ku ampL v2 tts = do+  n <- duration1000 file+  nGen2E4Gi n file m ku ampL v2 tts++-- | Generalized version of the 'overSoXSynthNGen2E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen2E4GPar :: FilePath -> Params -> Float -> Durations -> String -> IO ()+overSoXSynthNGen2E4GPar file params ampL v2 tts = do+  n <- duration1000 file+  nGen2E4GiPar n file params ampL v2 tts  ++-- | Similar to 'overSoXSynthN2', but uses a sound file to obtain the information analogous to list in the latter one. Besides, the function lifts+-- the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]). The first 'Float' argument from+-- the range [0.01..1.0] is used as a maximum amplitude for overtones. If it is set to 1.0 the overTones amplitudes are just maximum ones,+-- otherwise they are multiplied by the parameter and this results in their becoming more silent ones.+-- The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). 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.+-- +-- For better usage the 'FilePath' should be a filepath for the .wav file.+-- The second 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.+-- The third 'String' argument is used to define the intervals for the notes if any.+-- The third 'Float' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of+-- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones.+-- The last one is experimental feature.+overSoXSynthNGen3 :: FilePath -> Int -> Float -> Float -> Float -> String -> String -> String -> IO ()+overSoXSynthNGen3 file m = overSoXSynthNGen3E file m 12+{-# INLINE overSoXSynthNGen3 #-}+  +-- | Similar to 'overSoXSynthNGen3', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained+-- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'overSoXSynthNGen3'. To obtain+-- its modifications, please, use 2, 3, 4, 6, or 9.+overSoXSynthNGen3E :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> String -> IO ()+overSoXSynthNGen3E file m ku ampL time3 dAmpl zs tts vs = do+  n <- duration1000 file+  nGen3E4Gi n file m ku ampL dAmpl (str2DurationsDef n zs time3) tts vs++-- | Generalized version of the 'overSoXSynthNGen3E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3EPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> String -> IO ()+overSoXSynthNGen3EPar file params ampL time3 dAmpl zs tts vs = do+  n <- duration1000 file+  nGen3E4GiPar n file params ampL dAmpl (str2DurationsDef n zs time3) tts vs  ++-- | Variant of the 'overSoXSynthNGen3E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthNGen3E4GS :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> String -> IO ()+overSoXSynthNGen3E4GS file m ku ampL time3 dAmpl zs tts vs = do+  n <- duration1000 file+  nGen3E4Gi n file m ku ampL dAmpl (str2Durations zs time3) tts vs ++-- | Generalized version of the 'overSoXSynthNGen3E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3E4GSPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> String -> IO ()+overSoXSynthNGen3E4GSPar file params ampL time3 dAmpl zs tts vs = do+  n <- duration1000 file+  nGen3E4GiPar n file params ampL dAmpl (str2Durations zs time3) tts vs    ++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+nGen3E4Gi :: Int -> FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> String -> IO ()+nGen3E4Gi n file m ku ampL dAmpl v2 tts vs = do +  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  overSoXSynthN34G n ampL dAmpl v2 tts vs vecB+  endFromResult  ++-- | Generalized version of the 'nGen3E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+nGen3E4GiPar :: Int -> FilePath -> Params -> Float -> Float -> Durations -> String -> String -> IO ()+nGen3E4GiPar n file params ampL dAmpl v2 tts vs = do +  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  overSoXSynthN34G n ampL dAmpl v2 tts vs vecB+  endFromResult    ++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+nGen3E5Gi :: Int -> FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> Intervals -> IO ()+nGen3E5Gi n file m ku ampL dAmpl v2 tts v3 = do +  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  overSoXSynthN35G n ampL dAmpl v2 tts v3 vecB+  endFromResult  +    +-- | Generalized version of the 'nGen3E5Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+nGen3E5GiPar :: Int -> FilePath -> Params -> Float -> Float -> Durations -> String -> Intervals -> IO ()+nGen3E5GiPar n file params ampL dAmpl v2 tts v3 = do +  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  overSoXSynthN35G n ampL dAmpl v2 tts v3 vecB+  endFromResult      ++-- | 4G generalized function for 'overSoXSynthNGen3E' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthNGen3E4G :: FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> String -> IO ()+overSoXSynthNGen3E4G file m ku ampL dAmpl v2 tts vs = do+  n <- duration1000 file+  nGen3E4Gi n file m ku ampL dAmpl v2 tts vs++-- | Generalized version of the 'overSoXSynthNGen3E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3E4GPar :: FilePath -> Params -> Float -> Float -> Durations -> String -> String -> IO ()+overSoXSynthNGen3E4GPar file params ampL dAmpl v2 tts vs = do+  n <- duration1000 file+  nGen3E4GiPar n file params ampL dAmpl v2 tts vs  ++-- | 5G generalized function for 'overSoXSynthNGen3E4G' where you provide your own 'Intervals'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthNGen3E5G :: FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> Intervals -> IO ()+overSoXSynthNGen3E5G file m ku ampL dAmpl v2 tts v3 = do+  n <- duration1000 file+  nGen3E5Gi n file m ku ampL dAmpl v2 tts v3 ++-- | Generalized version of the 'overSoXSynthNGen3E5G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3E5GPar :: FilePath -> Params -> Float -> Float -> Durations -> String -> Intervals -> IO ()+overSoXSynthNGen3E5GPar file params ampL dAmpl v2 tts v3 = do+  n <- duration1000 file+  nGen3E5GiPar n file params ampL dAmpl v2 tts v3    ++-- | Variant of the 'overSoXSynthNGen3E5G' where 'Intervals' are obtained from the basic 'Intervals' with the length no more than 29 and a Ukrainian text +-- specified as the last 'String' argument so that you can produce 'Intervals' of the arbitrary length. For more information, please, refer to +-- 'intervalsFromStringG' and 'strToIntG'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthNGen3E5GS :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> Intervals -> String -> IO ()+overSoXSynthNGen3E5GS file m ku ampL time3 dAmpl zs tts v3 vs = do+  n <- duration1000 file+  nGen3E5Gi n file m ku ampL dAmpl (str2Durations zs time3) tts (intervalsFromStringG v3 vs)++-- | Generalized version of the 'overSoXSynthNGen3E5GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3E5GSPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> Intervals -> String -> IO ()+overSoXSynthNGen3E5GSPar file params ampL time3 dAmpl zs tts v3 vs = do+  n <- duration1000 file+  nGen3E5GiPar n file params ampL dAmpl (str2Durations zs time3) tts (intervalsFromStringG v3 vs)  +  +-- | 6G generalized function for 'overSoXSynthNGen3E5G' where you provide your own 'Strengths'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthNGen3E6G :: FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> Intervals -> Strengths -> Float -> IO ()+overSoXSynthNGen3E6G file m ku ampL dAmpl v2 tts v3 v6 limV = + overSoXSynthNGen3E5G file m ku ampL dAmpl v2 tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult++-- | Generalized version of the 'overSoXSynthNGen3E6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3E6GPar :: FilePath -> Params -> Float -> Float -> Durations -> String -> Intervals -> Strengths -> Float -> IO ()+overSoXSynthNGen3E6GPar file params ampL dAmpl v2 tts v3 v6 limV = + overSoXSynthNGen3E5GPar file params ampL dAmpl v2 tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult ++-- | A variant of 'overSoXSynthNGen3E6G' where 'Strengths' are obtained from a Ukrainian text specified as the last 'String' argument. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthNGen3E6GS :: FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> Intervals -> String -> Float -> IO ()+overSoXSynthNGen3E6GS file m ku ampL dAmpl v2 tts v3 xxs limV = overSoXSynthNGen3E6G file m ku ampL dAmpl v2 tts v3 (str2Volume xxs) limV+{-# INLINE overSoXSynthNGen3E6GS #-}++-- | Generalized version of the 'overSoXSynthNGen3E6GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3E6GSPar :: FilePath -> Params -> Float -> Float -> Durations -> String -> Intervals -> String -> Float -> IO ()+overSoXSynthNGen3E6GSPar file params ampL dAmpl v2 tts v3 xxs limV = overSoXSynthNGen3E6GPar file params ampL dAmpl v2 tts v3 (str2Volume xxs) limV+{-# INLINE overSoXSynthNGen3E6GSPar #-}++-- | A variant of 'overSoXSynthNGen3E6GS' where 'Strengths' and 'Durations' are obtained from the same Ukrainian text specified as +-- the last 'String' argument. The third 'Float' argument is an average duration of the sounds in seconds. +-- Note that 'Int' arguments are used by 'liftInEnku' in that order so it returns a 'Maybe' number (actually frequency) for +-- the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+overSoXSynthNGen3E6GSu :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> Intervals -> String -> Float -> IO ()+overSoXSynthNGen3E6GSu file m ku ampL dAmpl time3 tts v3 xxs = overSoXSynthNGen3E6G file m ku ampL dAmpl (str2Durations xxs time3) tts v3 (str2Volume xxs)+{-# INLINE overSoXSynthNGen3E6GSu #-}++-- | Generalized version of the 'overSoXSynthNGen3E6GSu' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+overSoXSynthNGen3E6GSuPar :: FilePath -> Params -> Float -> Float -> Float -> String -> Intervals -> String -> Float -> IO ()+overSoXSynthNGen3E6GSuPar file params ampL dAmpl time3 tts v3 xxs = overSoXSynthNGen3E6GPar file params ampL dAmpl (str2Durations xxs time3) tts v3 (str2Volume xxs)+{-# INLINE overSoXSynthNGen3E6GSuPar #-}
+ Composition/Sound/ParseList.hs view
@@ -0,0 +1,129 @@+-- |+-- Module      :  Composition.Sound.ParseList+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.ParseList where ++import Data.Char (isSpace)+--import qualified Data.Vector as V+import Data.List+import Data.Maybe (mapMaybe)+import Text.Read (lex,readMaybe)+import Data.Maybe (isNothing,fromMaybe)++parseTup :: String -> [String]+parseTup xs = map (dropWhile isSpace . fst) (takeWhile (/= ("","")) . iterate (head . lex . snd) $ head (lex xs))++containsExt :: [String] -> Bool+containsExt = elem ".." ++-- | Predicate to check whether a list does not contain round parentheses or dash (a minus sign) as its elements. Is used internally in the+-- 'parseStoLInts' function to avoid lists with negative elements.+canBePreParseV :: [String] -> Bool+canBePreParseV (xs:xss) = case xs of { "(" -> False ; "-" -> False ; ")" -> False ; ~bbb -> canBePreParseV xss }+canBePreParseV _ = True++-- | Notification. Uses an 'Int' limitation to avoid infinite lists. All arguments must be not negative.+parseV :: Int -> [String] -> Maybe [Int]+parseV n v+ | n >= 0 && findIndices (== "..") v == [2] && length v == 4 = +    if head v == "[" &&  (v !! 3) == "]"+      then let ins1 = readMaybe (v !! 1)::Maybe Int in+        case ins1 of+          Just ins -> if n <= ins then Just [ins] else Just [ins..n]+          Nothing  -> Nothing+      else Nothing+ | n >= 0 && findIndices (== "..") v == [2] && length v == 5 =+    if head v == "[" && v !! 4 == "]"+      then let ins1 = readMaybe (v !! 1)::Maybe Int +               ins2 = readMaybe (v !! 3)::Maybe Int in+        case (ins1,ins2) of+          (Just ins01,Just ins02) -> if ins02 >= ins01 then Just [ins01..ins02] else Nothing+          _                       -> Nothing+      else Nothing+ | n >= 0 && findIndices (== "..") v == [4] && length v == 6 =+    if head v == "[" && v !! 2 == "," && v !! 5 == "]" +      then let ins1 = readMaybe (v !! 1)::Maybe Int +               ins2 = readMaybe (v !! 3)::Maybe Int in+        case (ins1,ins2) of+          (Just ins01,Just ins02) ->+            case compare ins02 ins01 of+             GT -> if compare n ins02 /= LT then Just [ins01,ins02..n] else Just [ins01,ins02]+             EQ -> Just [ins01]+             _  -> Just [ins01,ins02..0]+          _                       -> Nothing+      else Nothing+ | n >= 0 && findIndices (== "..") v == [4] && length v == 7 =+    if head v == "[" && v !! 2 == "," && v !! 6 == "]" +      then let ins1 = readMaybe (v !! 1)::Maybe Int +               ins2 = readMaybe (v !! 3)::Maybe Int+               ins3 = readMaybe (v !! 5)::Maybe Int in+        case (ins1,ins2,ins3) of+          (Just ins01,Just ins02,Just ins03) -> if null [ins01,ins02..ins03] then Nothing else Just [ins01,ins02..ins03]+          _                       -> Nothing+      else Nothing+ | n >= 0 && head v == "[" && v !! (length v - 1) == "]" && length v `rem` 2 == 1 &&+    findIndices (== ",") v == [2,4..(length v - 2)] =+      let insV1 = map (\(i, _) -> readMaybe (v !! (2 * i + 1))::Maybe Int) . zip [0..] . take (length v `quot` 2) $ v in+       if any isNothing insV1+         then Nothing+         else Just (mapMaybe id insV1)+ | otherwise = Nothing++-- | From the 0.19.0.0 version. Can be used to parse also into infinite lists. +parseVInf :: [String] -> Maybe [Int]+parseVInf v+ | findIndices (== "..") v == [2] && length v == 4 =+    if head v == "[" && v !! 3 == "]"+      then let ins1 = readMaybe (v !! 1)::Maybe Int in+        case ins1 of+          Just ins -> Just [ins..]+          Nothing  -> Nothing+      else Nothing+ | findIndices (== "..") v == [2] && length v == 5 =+    if head v == "[" && v !! 4 == "]"+      then let ins1 = readMaybe (v !! 1)::Maybe Int+               ins2 = readMaybe (v !! 3)::Maybe Int in+        case (ins1,ins2) of+          (Just ins01,Just ins02) -> if ins02 >= ins01 then Just [ins01..ins02] else Nothing+          _                       -> Nothing+      else Nothing+ | findIndices (== "..") v == [4] && length v == 6 =+    if head v == "[" && v !! 2 == "," && v !! 5 == "]"+      then let ins1 = readMaybe (v !! 1)::Maybe Int+               ins2 = readMaybe (v !! 3)::Maybe Int in+        case (ins1,ins2) of+          (Just ins01,Just ins02) -> Just [ins01,ins02..]+          _                       -> Nothing+      else Nothing+ | findIndices (== "..") v == [4] && length v == 7 =+    if head v == "[" && v !! 2 == "," && v !! 6 == "]"+      then let ins1 = readMaybe (v !! 1)::Maybe Int+               ins2 = readMaybe (v !! 3)::Maybe Int+               ins3 = readMaybe (v !! 5)::Maybe Int in+        case (ins1,ins2,ins3) of+          (Just ins01,Just ins02,Just ins03) -> if null [ins01,ins02..ins03] then Nothing else Just [ins01,ins02..ins03]+          _                       -> Nothing+      else Nothing+ | head v == "[" && v !! (length v - 1) == "]" && length v `rem` 2 == 1 &&+    findIndices (== ",") v == [2,4..(length v - 2)] =+      let insV1 = map (\(i, _) -> readMaybe (v !! (2 * i + 1))::Maybe Int) . zip [0..] . take (length v `quot` 2) $ v in+       if any isNothing insV1+         then Nothing+         else Just (mapMaybe id insV1)+ | otherwise = Nothing ++-- | Parses a 'String' being a list of Ints written with Haskell rules, e. g. \"[1..]\", \"[2,4..45]\", \"[3,5,6,7,8,3]\" etc. into a list of 'Int'.+-- If it is not possible or list is empty, returns []. Preceding whitespaces are ignored. An 'Int' argument is used as a delimiter to avoid infinite lists.+parseStoLInts :: Int -> String -> [Int]+parseStoLInts n xs+  | canBePreParseV . parseTup . dropWhile isSpace $ xs = fromMaybe [] (parseV n (parseTup . dropWhile isSpace $ xs))+  | otherwise = []
+ Composition/Sound/Process.hs view
@@ -0,0 +1,250 @@+-- |+-- Module      :  Composition.Sound.Process+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.Process (+  -- * Basic functions for the executable+  recAndProcess+  , processD1+  --, processD2+  , d3H+  , d4H+  , d5H+  , d7H+  , d8H+  , d9H+) where++import Data.List (isPrefixOf)+import CaseBi.Arr (getBFstLSorted')+import Numeric (showFFloat)+import Control.Exception (onException)+import Sound.Control.Exception.FinalException+import System.Exit+import Data.Maybe (fromJust,isJust)+import Data.Char (isDigit,isSpace)+import System.Process+import System.Info (os)+import EndOfExe (showE)+import System.Directory++-- | 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 :: FilePath -> Int -> IO String+recAndProcess file =+  getBFstLSorted' processD [(0,processD0 file),(1,processD1), (3,processD3),(4,processD4),(5,processD5),+    (7,processD7), (8,processD8),(9,processD9),(11,processD_1),(99,processD99),(999,processD99)]++failureNotification :: IO ()+failureNotification = do+  putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."+  putStrLn "_______________________________________________________________________"++processD_1 :: IO String+processD_1 = onException (do+  putStr "Please, specify two \'Int\' numbers (with intermediate space character between them): the first one is a number of different notes there will be "+  putStr "in the result, and the second one is a number of enky, to which you would like all the main components (not taking into account their "+  putStr "respective lower bases of the intervals if any will exist) should belong. "+  putStrLn "If you specify as the first one 2 (possibly the simplest case), then to the second one you can define a number in the range [3..53]. "+  putStrLn "If you specify as the first one 3, then to the second one you can define a number in the range [2..35]. "+  putStrLn "If you specify as the first one 4, then to the second one you can define a number in the range [2..26]. "+  putStrLn "If you specify as the first one 6, then to the second one you can define a number in the range [1..17]. "+  putStrLn "If you specify as the first one 9, then to the second one you can define a number in the range [1..11]. "+  enka0 <- getLine+  let enka1 = take 2 . words . filter (\x -> isDigit x || isSpace x) $ enka0+      enka2 = read (head . take 1 $ enka1)::Int+      enka3+        | enka2 == 2 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 53) 3 == LT then 28 else (read (take 2 . head . tail $ enka1)::Int)+           `rem` 53+        | enka2 == 3 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 35) 2 == LT then 19 else (read (take 2 . head . tail $ enka1)::Int)+           `rem` 35+        | enka2 == 4 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 26) 2 == LT then 14 else (read (take 2 . head . tail $ enka1)::Int)+           `rem` 26+        | enka2 == 6 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 17) 1 == LT then 9 else (read (take 2 . head . tail $ enka1)::Int)+           `rem` 17+        | enka2 == 9 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 11) 1 == LT then 6 else (read (take 2 . head . tail $ enka1)::Int)+           `rem` 11+        | otherwise  = error "Not valid number in the second place. "+  return $ show enka2 ++ " " ++ show enka3 ) (failureNotification >> processD3)+{-# INLINE processD_1 #-}++processD0 :: FilePath -> IO String+processD0 file = 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 "_______________________________________________________________________"+  processD0 file)+{-# INLINE processD0 #-}+  +processD1 :: IO String+processD1 = 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)::Float+  putStrLn "Please, wait for 0.5 second and produce the needed sound now."+  {- The following sample of code is taken from the recA function of the SoXBasics module in the @mmsyn7ukr@ package. -}+  if isJust (showE "sox") && take 5 os == "mingw" then do+   (code, _, _) <- readProcessWithExitCode (fromJust (showE "sox")) ["-t","waveaudio","-d","-b16", "-c1", "-esigned-integer", "-L", "x.wav", "trim", "0.5", showFFloat Nothing time0 $ show 0] ""+   if code /= ExitSuccess+    then do+      e0 <- doesFileExist "x.wav"+      if e0+        then do+          removeFile "x.wav"+          catchEnd (NotRecorded "x.wav")+        else catchEnd (NotRecorded "x.wav")+     else do+      e1 <- doesFileExist "x.wav"+      if e1+        then return ()+        else catchEnd (NotRecorded "x.wav")+  else if isJust (showE "rec") then do+   (code, _, _) <- readProcessWithExitCode (fromJust (showE "rec")) ["-b16", "-c1", "-esigned-integer", "-L", "x.wav", "trim", "0.5", showFFloat Nothing time0 $ show 0] ""+   if code /= ExitSuccess+    then do+      e0 <- doesFileExist "x.wav"+      if e0+        then do+          removeFile "x.wav"+          catchEnd (NotRecorded "x.wav")+        else catchEnd (NotRecorded "x.wav")+    else do+      e1 <- doesFileExist "x.wav"+      if e1+        then return ()+        else catchEnd (NotRecorded "x.wav")+   else catchEnd ExecutableNotProperlyInstalled -- End of the sample code for 'recA'+  putStrLn ""+  return "") (do+    dir0 <- listDirectory "."+    let paths = filter (== "x.wav") dir0+    mapM_ removeFile paths+    putStrLn ""+    failureNotification +    processD1)+{-# INLINE processD1 #-}++processD3 :: IO String+processD3 = 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]"+  fmap d3H getLine) (failureNotification >> processD3)+{-# INLINE processD3 #-}++d3H :: String -> String+d3H xs = show $ (read (take 1 xs)::Int) `rem` 9+{-# INLINE d3H #-}++processD4 :: IO String+processD4 = onException (do+  putStr "Please, specify the amplitude for the generated overtones 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."+  fmap d4H getLine) (failureNotification >> processD4)+{-# INLINE processD4 #-}++d4H :: String -> String+d4H xs+ | null xs = "1.0"+ | otherwise = let amplOb = (read (take 2 . filter isDigit $ xs)::Int) `rem` 100 in+    case amplOb of+      99 -> "1.0"+      _ -> if compare (amplOb `quot` 9) 1 == LT then "0.0" ++ show (amplOb + 1)+           else "0." ++ show (amplOb + 1)+{-# INLINE d4H #-}++processD5 :: IO String+processD5 = onException (do+  putStr "Please, specify the basic duration for the generated sounds as a Float 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."+  fmap d5H getLine) (failureNotification >> processD5)+{-# INLINE processD5 #-}++d5H :: String -> String+d5H xs+  | null xs = "0.5"+  | otherwise = let time1 = (read (filter (\z -> isDigit z || z == '.') xs)::Float) in+      if compare time1 0.1 /= LT && compare time1 4.0 /= GT then showFFloat (Just 4) time1 $ show 0+      else let mantissa = time1 - (fromIntegral . truncate $ time1)+               ceilP    = (truncate time1::Int) `rem` 4 in+             if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0)+             else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0)+{-# INLINE d5H #-}++processD7 :: IO String+processD7 = 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: "+  fmap d7H getLine) (failureNotification >> +    processD7)+{-# INLINE processD7 #-}++d7H :: String -> String+d7H xs+  | null xs = "або"+  | otherwise = xs+{-# INLINE d7H #-}++processD8 :: IO String+processD8 = 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."+  fmap d8H getLine) (failureNotification >> processD8)+{-# INLINE processD8 #-}++d8H :: String -> String+d8H xs+  | null xs = "1.0"+  | otherwise = let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') xs)::Float) in+    if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then showFFloat (Just 4) dAmpl1 $ show 0+    else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1)+             ceilP    = (truncate dAmpl1::Int) `rem` 2 in+           if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0)+           else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0)+{-# INLINE d8H #-}++processD9 :: IO String+processD9 = onException (do+  putStrLn "Please, input the Ukrainian text that will be used to define the 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."+  fmap d9H getLine) (failureNotification >> processD9)+{-# INLINE processD9 #-}++d9H :: String -> String+d9H xs+  | null xs = "й"+  | otherwise = xs+{-# INLINE d9H #-}++processD :: IO String+processD = onException (do+  putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: "+  getLine) (failureNotification >> processD)+{-# INLINE processD #-}++processD99 :: IO String+processD99 = onException (do+  putStr "Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indices for the files to be played "+  putStr "with SoX effects applied to. The lists must be separated with newline (just press \"Enter\"), empty lists are ignored. If index is an "+  putStrLn "element of several input lists then if its number of occurrences in all the lists is odd, then it is played, otherwise it is not. "+  putStrLn "To end the input, just press the combination that means the end of input (e. g. for Unices, it's probably Ctrl + D). "+  getContents) (failureNotification >> processD)+{-# INLINE processD99 #-}++----------------------------------------------------------------------------------------------   +
+ Composition/Sound/Uniq.hs view
@@ -0,0 +1,696 @@+-- |+-- Module      :  Composition.Sound.Uniq+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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.++{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -threaded #-}+{-# OPTIONS_HADDOCK show-extensions #-}++module Composition.Sound.Uniq (+  -- * Library and executable functions+  -- ** For the unique for the String structure timbre+  uniqOvertonesV+  , uniqOverSoXSynth+  , uniqOverSoXSynthN+  -- *** For the unique for the String structure timbre with different signs for harmonics coefficients+  , uniqOvertonesV2+  , uniqOverSoXSynth2+  , uniqOverSoXSynthN3+  , uniqOverSoXSynthN4+  -- *** Use a file for information+  , uniqOverSoXSynthNGen+  , uniqOverSoXSynthNGen3+  , uniqOverSoXSynthNGen4+  -- * Extended generation using enky functionality+ -- ** With usage of additional information in the Ukrainian text+  , uniqOverSoXSynthNGenE+  , uniqOverSoXSynthNGen3E+  , uniqOverSoXSynthNGen4E+  -- * New 4G functions to work with Durations+  , uniqOverSoXSynthN4G+  , uniqOverSoXSynthN34G+  , uniqOverSoXSynthN44G+  , uniqOverSoXSynthNGenE4G+  , uniqOverSoXSynthNGen3E4G+  , uniqOverSoXSynthNGen4E4G+  -- ** 4G with speech-like composition+  , uniqOverSoXSynthN4GS+  , uniqOverSoXSynthN34GS+  , uniqOverSoXSynthN44GS+  , uniqOverSoXSynthNGenE4GS+  , uniqOverSoXSynthNGen3E4GS+  , uniqOverSoXSynthNGen4E4GS+  -- * New 5G functions to work also with Intervals+  , uniqOverSoXSynthN45G+  , uniqOverSoXSynthNGen4E5G+  -- ** 5G with obtained from the text arbitraty length Intervals+  , uniqOverSoXSynthN45GS+  , uniqOverSoXSynthNGen4E5GS+  -- * New 6G function to work also with Strengths+  , uniqOverSoXSynthNGen4E6G+  -- ** 6G with obtained from the text arbitrary length Strengths+  , uniqOverSoXSynthN46GS+  , uniqOverSoXSynthN46GSu+  , uniqOverSoXSynthNGen4E6GS+  , uniqOverSoXSynthNGen4E6GSu+  -- ** With overtones obtained from the additional Ukrainian text+  , uniqOverSoXSynthNGenEPar+  , uniqOverSoXSynthNGenE4GSPar+  , uniqOverSoXSynthNGenE4GPar+  , uniqOverSoXSynthNGen3EPar+  , uniqOverSoXSynthNGen3E4GSPar+  , uniqOverSoXSynthNGen3E4GPar+  , uniqOverSoXSynthNGen4EPar+  , uniqOverSoXSynthNGen4E4GSPar+  , uniqOverSoXSynthNGen4E4GPar+  , uniqOverSoXSynthNGen4E5GPar+  , uniqOverSoXSynthNGen4E5GSPar+  , uniqOverSoXSynthNGen4E6GPar+  , uniqOverSoXSynthNGen4E6GSPar+  , uniqOverSoXSynthNGen4E6GSuPar+) where++--import GHC.Int+import Numeric (showFFloat)+import Data.Maybe (isNothing,fromJust)+--import qualified Data.Vector as V+import GHC.Arr+import qualified Data.Foldable as F+import Data.Foldable.Ix+import System.Process+import EndOfExe (showE)+import Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base+import Composition.Sound.Functional.Basics+import Composition.Sound.Functional.Params+import Composition.Sound.DIS5G6G++-- | For the given frequency of the note it generates a list of the tuples, each one of which contains the harmonics' frequency and amplitude. For every given+-- 'String' structure of the uniqueness (see the documentation for @ukrainian-phonetics-basic-array@ and @uniqueness-periods@ packages) it produces the unique timbre.+uniqOvertonesV :: Float -> String -> OvertonesO+uniqOvertonesV note xs =+  let ys = uniquenessPeriodsG "-01" xs+      z  = sum ys+      v  = fmap (\y -> fromIntegral y / fromIntegral z) $ ys+      vA = (\rs -> listArray (0, length rs - 1) rs) v+      z2 = length v+      v2 = map (\i -> unsafeAt vA i / fromIntegral (i + 1)) [0..z2 - 1] in+        takeWhile (\(!u,!z) -> u <= unsafeAt notes 107 && abs z > 0.001) . s2L 1 (z2 - 1) .+          zip (map (\i -> note * fromIntegral (i + 1)) [0..z2 - 1]) $ v2++-- | For the given frequency of the note it generates a list of the tuples, each one of which contains the harmonics' frequency and amplitude. For every given+-- first 'String' argument structure of the uniqueness (see the documentation for @ukrainian-phonetics-basic-array@ and @uniqueness-periods@ packages) it produces the unique timbre.+-- The second 'String' is used to produce the signs for harmonics coefficients.+uniqOvertonesV2 :: Float -> String -> String -> OvertonesO+uniqOvertonesV2 note xs ts = +  let ys = uniquenessPeriodsG "-01" xs+      z  = sum ys+      v  = fmap (\y -> fromIntegral y / fromIntegral z) ys+      vA = (\rs -> listArray (0, length rs - 1) rs) v+      z2 = numElements vA+      v2 = map (\i -> (unsafeAt (amap fromIntegral . signsFromString z2 $ ts) i) * unsafeAt vA i / fromIntegral (i + 1)) [0.. z2 - 1] in+        takeWhile (\(!u,!z) -> u <= unsafeAt notes 107 && abs z > 0.001) . filter (\(_, t4) -> t4 /= 0.0) .+          s2L 1 (z2 - 1) . zip (map (\i -> note * fromIntegral (i + 1)) [0..z2 - 1]) $ v2+  +-- | For the given frequency and a Ukrainian text it generates a musical sound with the timbre obtained from the Ukrainian text (see the+-- documentation for @ukrainian-phonetics-basic-array@ package). The timbre for another given text usually differs, but can be the same. The last one is only+-- if the uniqueness structure and length are the same for both 'String'. Otherwise, they differs. This gives an opportunity to practically+-- and quickly synthesize differently sounding intervals. 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*\" files in the current directory, because they can be overwritten.+uniqOverSoXSynth :: Float -> String -> IO ()+uniqOverSoXSynth x wws = do+  let note0 = closestNote x+      note1 = pureQuintNote note0+      v0    = uniqOvertonesV note0 wws+      v1    = uniqOvertonesV note1 wws+  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test-.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 "",+     "synth", "0.5","sine", "mix", showFFloat (Just 4) note1 "", "vol","0.5"] ""+  uniqOverSoXSynthHelp v0+  uniqOverSoXSynthHelp2 v1+  mixTest++uniqOverSoXSynthHelp1 :: String -> OvertonesO -> IO ()+uniqOverSoXSynthHelp1 xs = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+ ["-r22050", "-n", xs ++ show (i + 2) ++ ".wav", "synth", "0.5","sine", showFFloat (Just 4) noteN "", "vol", showFFloat (Just 4) amplN ""] "") . zip [0..] ++uniqOverSoXSynthHelp :: OvertonesO -> IO ()+uniqOverSoXSynthHelp = uniqOverSoXSynthHelp1 "test0"++uniqOverSoXSynthHelp2 :: OvertonesO -> IO ()+uniqOverSoXSynthHelp2 = uniqOverSoXSynthHelp1 "test1"++-- | For the given frequency and a Ukrainian text it generates a musical sound with the timbre obtained from the Ukrainian text (see the+-- documentation for @ukrainian-phonetics-basic-array@ package). The timbre for another given text usually differs, but can be the same. The last one is only+-- if the uniqueness structure and length are the same for both 'String'. Otherwise, they differs. This gives an opportunity to practically+-- and quickly synthesize differently sounding intervals. 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*\" files in the current directory, because they can be overwritten.+-- The second 'String' argument is used to define signs for the harmonics coefficients for Overtones.+uniqOverSoXSynth2 :: Float -> String -> String -> IO ()+uniqOverSoXSynth2 x wws tts = do+  let note0 = closestNote x+      note1 = pureQuintNote note0+      v0    = uniqOvertonesV2 note0 wws tts+      v1    = uniqOvertonesV2 note1 wws tts+  _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test-.wav", "synth", "0.5","sine", showFFloat (Just 4) note0 "", "synth",+     "0.5","sine", "mix", showFFloat (Just 4) note1 "", "vol","0.5"] ""+  uniqOverSoXSynthHelp v0+  uniqOverSoXSynthHelp2 v1+  mixTest++-- | Function to create a melody for the given arguments. The first 'String' is used to provide a rhythm. The second one -- to provide a timbre.+-- The timbre for another given text usually differs, but can be the same. This gives an opportunity to practically and quickly+-- synthesize differently sounding intervals. The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones.+-- If it is set to 1.0 the overTones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in+-- their becoming more silent ones. The main component of the sound is in the given octave with a number given+-- by 'Int' parameter. Besides, another 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. The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.+uniqOverSoXSynthN :: Int -> Float -> Float -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN n ampL time3 zs = uniqOverSoXSynthN4G n ampL (str2DurationsDef n zs time3)+{-# INLINE uniqOverSoXSynthN #-}++-- | Variant of the 'uniqOverSoXSynthN4G' function where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+uniqOverSoXSynthN4GS :: Int -> Float -> Float -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN4GS n ampL time3 zs = uniqOverSoXSynthN4G n ampL (str2Durations zs time3)+{-# INLINE uniqOverSoXSynthN4GS #-}++-- | 4G generalized variant of the 'uniqOverSoXSynthN' where you specify your own 'Durations'.+uniqOverSoXSynthN4G :: Int -> Float -> Durations -> String -> [Float] -> IO ()+uniqOverSoXSynthN4G n ampL v2 wws vec0+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Uniq.uniqOverSoXSynthN4G: You provided no valid durations data! "+ | abs ampL >= 0.01 && abs ampL <= 1.0 =+    let v21 = (\rs -> listArray (0,length rs -1) rs) . filter (/= 0.0) . elems $ v2+        m     = numElements v21+        zeroN = numVZeroesPre vec0 in mapM_ (\(j, x) -> do+          let note0 = closestNote x+              note1 = pureQuintNote note0+              v0    = uniqOvertonesV note0 wws+              v1    = uniqOvertonesV note1 wws+              uniqOverSoXSynthHelpN = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                   "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0+                      then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]+              uniqOverSoXSynthHelpN2 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                   "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0+                      then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]+              soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" +++                 prependZeroes zeroN "1" ++  ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "", "synth", showFFloat (Just 4) (unsafeAt v2 (j `rem` m)) "","sine", "mix", showFFloat (Just 4) note02 "", "vol",+                    if unsafeAt v21 (j `rem` m) > 0.0 then "0.5" else "0"]  ""+          _ <- soxSynthHelpMain note0 note1+          uniqOverSoXSynthHelpN v0+          uniqOverSoXSynthHelpN2 v1+          mixTest2 zeroN j) . zip [0..] $ vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then uniqOverSoXSynthN4G n 0.01 v2 wws vec0+    else uniqOverSoXSynthN4G n ampL1 v2 wws vec0+ +-- | Function to create a melody for the given arguments. The first 'String' is used to provide a rhythm. The second one -- to provide a timbre.+-- The timbre for another given text usually differs, but can be the same. This gives an opportunity to practically and quickly+-- synthesize differently sounding intervals. The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones.+-- If it is set to 1.0 the overTones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in+-- their becoming more silent ones. The main component of the sound is in the given octave with a number given+-- by 'Int' parameter. Besides, another 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. The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.+-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.+uniqOverSoXSynthN3 :: Int -> Float -> Float -> String -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN3 n ampL time3 zs = uniqOverSoXSynthN34G n ampL (str2DurationsDef n zs time3)+{-# INLINE uniqOverSoXSynthN3 #-}++-- | Variant of the 'uniqOverSoXSynthN34G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+uniqOverSoXSynthN34GS :: Int -> Float -> Float -> String -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN34GS n ampL time3 zs = uniqOverSoXSynthN34G n ampL (str2Durations zs time3)+{-# INLINE uniqOverSoXSynthN34GS #-}++help14 :: Int -> Float -> Durations -> String -> String -> [Float] -> IO ()+help14 n ampL v2 wws tts vec0+ | abs ampL >= 0.01 && abs ampL <= 1.0 = do+    let v21 = (\rs -> listArray (0,length rs -1) rs) . filter (/=0.0) . elems $ v2+        m     = length v2+        zeroN = numVZeroesPre vec0 in mapM_ (\(j, x) -> do   +          let note0 = closestNote x   +              note1 = pureQuintNote note0+              v0    = uniqOvertonesV2 note0 wws tts+              v1    = uniqOvertonesV2 note1 wws tts+              uniqOverSoXSynthHelpN = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                   "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]+              uniqOverSoXSynthHelpN2 = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                   "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]+              soxSynthHelpMain note01 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" +++                prependZeroes zeroN "1" ++  ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "",+                  "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", "mix", showFFloat (Just 4) note02 "", "vol",+                    if unsafeAt v21 (j `rem` m) > 0.0 then "0.5" else "0"] ""+          _ <- soxSynthHelpMain note0 note1+          uniqOverSoXSynthHelpN v0+          uniqOverSoXSynthHelpN2 v1+          mixTest2 zeroN j) . zip [0..] $ vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then uniqOverSoXSynthN34G n 0.01 v2 wws tts vec0+    else uniqOverSoXSynthN34G n ampL1 v2 wws tts vec0    ++-- | 4G generalized variant of the 'uniqOverSoXSynthN3' where you specify your own 'Durations'. +uniqOverSoXSynthN34G :: Int -> Float -> Durations -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN34G n ampL v2 wws tts vec0+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Uniq.uniqOverSoXSynthN34G: You provided no valid durations data! "+ | otherwise = help14 n ampL v2 wws tts vec0+ +-- | Function to create a melody for the given arguments. The first 'String' is used to provide a rhythm. The second one -- to provide a timbre.+-- The timbre for another given text usually differs, but can be the same. This gives an opportunity to practically and quickly+-- synthesize differently sounding intervals. The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones.+-- If it is set to 1.0 the overTones amplitudes are just maximum ones, otherwise they are multiplied by the parameter and this results in+-- their becoming more silent ones. The main component of the sound is in the given octave with a number given+-- by 'Int' parameter. Besides, another 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. The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). Please, check before executing+-- whether there is no \"x.wav\", \"test*\", \"result*\" files in the current directory, because they can be overwritten.+-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.+-- The fourth 'String' argument is used to define the intervals for the notes if any.+-- The third 'Float' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of+-- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones.+-- The last one is experimental feature.+uniqOverSoXSynthN4 :: Int -> Float -> Float -> Float -> String -> String -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN4 n ampL time3 dAmpl zs = uniqOverSoXSynthN44G n ampL dAmpl (str2DurationsDef n zs time3)+{-# INLINE uniqOverSoXSynthN4 #-}++-- | Variant of the 'uniqOverSoXSynthN44G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition.+uniqOverSoXSynthN44GS :: Int -> Float -> Float -> Float -> String -> String -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN44GS n ampL time3 dAmpl zs = uniqOverSoXSynthN44G n ampL dAmpl (str2Durations zs time3)+{-# INLINE uniqOverSoXSynthN44GS #-}++-- | 4G generalized variant of the 'uniqOverSoXSynthN4' where you specify your own 'Durations'. +uniqOverSoXSynthN44G :: Int -> Float -> Float -> Durations -> String -> String -> String -> [Float] -> IO ()+uniqOverSoXSynthN44G n ampL dAmpl v2 wws tts vs = uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts (intervalsFromString vs)+{-# INLINE uniqOverSoXSynthN44G #-}++help15 :: Int -> Float -> Float -> Durations -> String -> String -> Intervals -> [Float] -> IO ()+help15 n ampL dAmpl v2 wws tts v3 vec0 = do+  let v21 = (\rs -> listArray (0,length rs -1) rs). filter (/=0.0) . elems $ v2+      m     = numElements v2+      zeroN = numVZeroesPre vec0+      l     = numElements v3 in mapM_ (\(j, x) -> do   +          let note0 = closestNote x+              note1 = dNote (unsafeAt v3 (j `rem` l)) note0+              v0    = uniqOvertonesV2 note0 wws tts+              v1    = if isNothing note1 then []+                      else uniqOvertonesV2 (fromJust note1) wws tts+              uniqOverSoXSynthHelpN = mapM_ (\(i, (noteN, !amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "test" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                  "sine",showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (amplN * ampL) "" else "0"] "") . zip [0..]+              uniqOverSoXSynthHelpN2 = mapM_ (\(i, (noteN, amplN)) -> readProcessWithExitCode (fromJust (showE "sox"))+                ["-r22050", "-n", "testQ" ++ prependZeroes zeroN (show (i + 2)) ++ ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "",+                   "sine", showFFloat (Just 4) noteN "", "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (if dAmpl * amplN * ampL > 1.0 then 1.0+                      else dAmpl * amplN * ampL) "" else "0"] "") . zip [0..] +              soxSynthHelpMain0 note01 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA" +++                 prependZeroes zeroN "1" ++  ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note01 "",+                   "vol",if unsafeAt v21 (j `rem` m) > 0.0 then "0.5" else "0"] ""+              soxSynthHelpMain1 note02 = readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB" +++                 prependZeroes zeroN "1" ++  ".wav", "synth", showFFloat (Just 4) (abs (unsafeAt v21 (j `rem` m))) "","sine", showFFloat (Just 4) note02 "",+                    "vol", if unsafeAt v21 (j `rem` m) > 0.0 then showFFloat (Just 4) (if dAmpl > 0.5 then 0.5 else dAmpl / 2) "" else "0"] ""+          if isNothing note1 then do { _ <- soxSynthHelpMain0 note0+                                     ; uniqOverSoXSynthHelpN v0 }+          else do { _ <- soxSynthHelpMain0 note0+                  ; _ <- soxSynthHelpMain1 (fromJust note1)+                  ; uniqOverSoXSynthHelpN v0+                  ; uniqOverSoXSynthHelpN2 v1}+          mixTest2 zeroN j) . zip [0..] $ vec0+ +-- | 5G generalized variant of the 'uniqOverSoXSynthN44G' where you specify your own 'Intervals'. +uniqOverSoXSynthN45G :: Int -> Float -> Float -> Durations -> String -> String -> Intervals -> [Float] -> IO ()+uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts v3 vec0+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Uniq.uniqOverSoXSynthN45G: You provided no valid durations data! "+ | abs ampL >= 0.01 && abs ampL <= 1.0 = help15 n ampL dAmpl v2 wws tts v3 vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then uniqOverSoXSynthN45G n 0.01 dAmpl v2 wws tts v3 vec0+    else uniqOverSoXSynthN45G n ampL1 dAmpl v2 wws tts v3 vec0    ++-- | 6G generalized variant of the 'uniqOverSoXSynthN45G' where you specify your own 'Strengths' and a limit (as the last 'Float') when less volume level +-- sound files are treated as a silent ones and are not adjusted. +uniqOverSoXSynthN46G :: Int -> Float -> Float -> Durations -> String -> String -> Intervals -> [Float] -> Strengths -> Float -> IO ()+uniqOverSoXSynthN46G n ampL dAmpl v2 wws tts v3 vec0 v6 limV+ | F.all (== 0.0) v2 = putStrLn "Composition.Sound.Uniq.uniqOverSoXSynthN46G: You provided no valid durations data! "+ | F.null v6 = putStrLn "Composition.Sound.Uniq.uniqOverSoXSynthN46G: You did not provide a volume adjustments vector! "+ | abs ampL >= 0.01 && abs ampL <= 1.0 = do+     let zeroN = numVZeroesPre vec0+         l6 = numElements v6+     help15 n ampL dAmpl v2 wws tts v3 vec0+     mapM_ (\(j, _) -> apply6GSilentFile ("result" ++ prependZeroes zeroN (show j) ++ ".wav") limV (unsafeAt v6 (j `rem` l6))) . zip [0..] $ vec0+ | otherwise = let ampL1 = ampL - (fromIntegral . truncate $ ampL) in+    if abs ampL1 < 0.01 then uniqOverSoXSynthN46G n 0.01 dAmpl v2 wws tts v3 vec0 v6 limV+    else uniqOverSoXSynthN46G n ampL1 dAmpl v2 wws tts v3 vec0 v6 limV++-- | Variant of the 'uniqOverSoXSynthN45G' where 'Intervals' are obtained from the 'String' using 'intervalsFromStringG' function. Helps to create a speech-like +-- composition.+uniqOverSoXSynthN45GS :: Int -> Float -> Float -> Float -> String -> String -> String -> Intervals -> String -> [Float] -> IO ()+uniqOverSoXSynthN45GS n ampL time3 dAmpl zs wws tts v3 vs = uniqOverSoXSynthN45G n ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v3 vs)+{-# INLINE uniqOverSoXSynthN45GS #-}++-- | Variant of the 'uniqOverSoXSynthN46G' where 'Strengths' are obtained from the 'String' using 'str2Volume' function. Helps to create a speech-like +-- composition.+uniqOverSoXSynthN46GS :: Int -> Float -> Float -> Float -> String -> String -> String -> Intervals -> String -> [Float] -> String ->+  Float -> IO ()+uniqOverSoXSynthN46GS n ampL time3 dAmpl zs wws tts v3 vs vec0 xxs limV = uniqOverSoXSynthN46G n ampL dAmpl (str2Durations zs time3) wws tts +  (intervalsFromStringG v3 vs) vec0 (str2Volume xxs) limV+{-# INLINE uniqOverSoXSynthN46GS #-}++-- | A variant of 'uniqOverSoXSynthN46GS' where 'Strengths' and 'Durations' are obtained from the same Ukrainian text specified as +-- the last 'String' argument. The second 'Float' argument is an average duration of the sounds in seconds. +-- Note that 'Int' arguments are used by 'liftInEnku' in that order so it returns a 'Maybe' number (actually frequency) for +-- the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthN46GSu :: Int -> Float -> Float -> Float -> String -> String -> Intervals -> String -> [Float] -> String -> Float -> IO ()+uniqOverSoXSynthN46GSu n ampL time3 dAmpl wws tts v5 vs vec0 xxs limV = + uniqOverSoXSynthN46G n ampL dAmpl (str2Durations xxs time3) wws tts (intervalsFromStringG v5 vs) vec0 (str2Volume xxs) limV+{-# INLINE uniqOverSoXSynthN46GSu #-} ++-- | Similar to 'uniqOverSoXSynthN', but uses a sound file to obtain the information analogous to 'Array' 'Int' in the latter one. +-- Besides, the function lifts the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]).+-- The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the+-- overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones.+-- The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). 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.+--+-- For better usage the 'FilePath' should be a filepath for the .wav file.+uniqOverSoXSynthNGen :: FilePath -> Int -> Float -> Float -> String -> String -> IO ()+uniqOverSoXSynthNGen file m = uniqOverSoXSynthNGenE file m 12+{-# INLINE uniqOverSoXSynthNGen #-}++-- | Similar to 'uniqOverSoXSynthNGen', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained+-- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'uniqOverSoXSynthNGen'. To obtain+-- its modifications, please, use 2, 3, 4, 6, or 9. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGenE :: FilePath -> Int -> Int -> Float -> Float -> String -> String -> IO ()+uniqOverSoXSynthNGenE file m ku ampL time3 zs wws = do+  n <- duration1000 file+  unGenNE4Gi n file m ku ampL (str2DurationsDef n zs time3) wws++-- | Generalized version of the 'uniqOverSoXSynthNGenE' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGenEPar :: FilePath -> Params -> Float -> Float -> String -> String -> IO ()+uniqOverSoXSynthNGenEPar file params ampL time3 zs wws = do+  n <- duration1000 file+  unGenNE4GiPar n file params ampL (str2DurationsDef n zs time3) wws  ++-- | Variant of the 'uniqOverSoXSynthNGenE4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGenE4GS :: FilePath -> Int -> Int -> Float -> Float -> String -> String -> IO ()+uniqOverSoXSynthNGenE4GS file m ku ampL time3 zs wws = do+  n <- duration1000 file+  unGenNE4Gi n file m ku ampL (str2Durations zs time3) wws+  +-- | Generalized version of the 'uniqOverSoXSynthNGenE4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGenE4GSPar :: FilePath -> Params -> Float -> Float -> String -> String -> IO ()+uniqOverSoXSynthNGenE4GSPar file params ampL time3 zs wws = do+  n <- duration1000 file+  unGenNE4GiPar n file params ampL (str2Durations zs time3) wws  ++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+unGenNE4Gi :: Int -> FilePath -> Int -> Int -> Float -> Durations -> String -> IO ()+unGenNE4Gi n file m ku ampL v2 wws = do+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  uniqOverSoXSynthN4G n ampL v2 wws vecB+  endFromResult++-- | Generalized version of the 'unGenNE4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+unGenNE4GiPar :: Int -> FilePath -> Params -> Float -> Durations -> String -> IO ()+unGenNE4GiPar n file params ampL v2 wws = do+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  uniqOverSoXSynthN4G n ampL v2 wws vecB+  endFromResult  ++-- | 4G genaralized version of the 'uniqOverSoXSynthNGenE' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGenE4G :: FilePath -> Int -> Int -> Float -> Durations -> String -> IO ()+uniqOverSoXSynthNGenE4G file m ku ampL v2 wws = do+  n <- duration1000 file+  unGenNE4Gi n file m ku ampL v2 wws++-- | Generalized version of the 'uniqOverSoXSynthNGenE4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGenE4GPar :: FilePath -> Params -> Float -> Durations -> String -> IO ()+uniqOverSoXSynthNGenE4GPar file params ampL v2 wws = do+  n <- duration1000 file+  unGenNE4GiPar n file params ampL v2 wws   ++-- | Similar to 'uniqOverSoXSynthN', but uses a sound file to obtain the information analogous to 'Array' 'Int' in the latter one. +-- Besides, the function lifts the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]).+-- The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the+-- overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones.+-- The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). 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.+--+-- For better usage the 'FilePath' should be a filepath for the .wav file.+-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.+uniqOverSoXSynthNGen3 :: FilePath -> Int -> Float -> Float -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen3 file m = uniqOverSoXSynthNGen3E file m 12+{-# INLINE uniqOverSoXSynthNGen3 #-}++-- | Similar to 'uniqOverSoXSynthNGen3', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained+-- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'uniqOverSoXSynthNGen3'. To obtain+-- its modifications, please, use 2, 3, 4, 6, or 9. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen3E :: FilePath -> Int -> Int -> Float -> Float -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen3E file m ku ampL time3 zs wws tts = do+  n <- duration1000 file+  unGenN3E4Gi n file m ku ampL (str2DurationsDef n zs time3) wws tts++-- | Generalized version of the 'uniqOverSoXSynthNGen3E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen3EPar :: FilePath -> Params -> Float -> Float -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen3EPar file params ampL time3 zs wws tts = do+  n <- duration1000 file+  unGenN3E4GiPar n file params ampL (str2DurationsDef n zs time3) wws tts  ++-- | Variant of the 'uniqOverSoXSynthNGen3E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen3E4GS :: FilePath -> Int -> Int -> Float -> Float -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen3E4GS file m ku ampL time3 zs wws tts = do+  n <- duration1000 file+  unGenN3E4Gi n file m ku ampL (str2Durations zs time3) wws tts++-- | Generalized version of the 'uniqOverSoXSynthNGen3E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen3E4GSPar :: FilePath -> Params -> Float -> Float -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen3E4GSPar file params ampL time3 zs wws tts = do+  n <- duration1000 file+  unGenN3E4GiPar n file params ampL (str2Durations zs time3) wws tts++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+unGenN3E4Gi :: Int -> FilePath -> Int -> Int -> Float -> Durations -> String -> String -> IO ()+unGenN3E4Gi n file m ku ampL v2 wws tts = do+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  uniqOverSoXSynthN34G n ampL v2 wws tts vecB+  endFromResult++-- | Generalized version of the 'unGenN3E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+unGenN3E4GiPar :: Int -> FilePath -> Params -> Float -> Durations -> String -> String -> IO ()+unGenN3E4GiPar n file params ampL v2 wws tts = do+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  uniqOverSoXSynthN34G n ampL v2 wws tts vecB+  endFromResult  ++-- | 4G genaralized version of the 'uniqOverSoXSynthNGen3E' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen3E4G :: FilePath -> Int -> Int -> Float -> Durations -> String -> String -> IO ()+uniqOverSoXSynthNGen3E4G file m ku ampL v2 wws tts = do+  n <- duration1000 file+  unGenN3E4Gi n file m ku ampL v2 wws tts+   +-- | Generalized version of the 'uniqOverSoXSynthNGen3E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen3E4GPar :: FilePath -> Params -> Float -> Durations -> String -> String -> IO ()+uniqOverSoXSynthNGen3E4GPar file params ampL v2 wws tts = do+  n <- duration1000 file+  unGenN3E4GiPar n file params ampL v2 wws tts   ++-- | Similar to 'uniqOverSoXSynthN', but uses a sound file to obtain the information analogous to 'Array' 'Int' in the latter one. +-- Besides, the function lifts the frequencies to the octave with the given by 'Int' parameter number (better to use from the range [1..8]).+-- The first 'Float' argument from the range [0.01..1.0] is used as a maximum amplitude for Overtones. If it is set to 1.0 the+-- overTones amplitudes are just the maximum ones, otherwise they are multiplied by the parameter and this results in their becoming more silent ones.+-- The second 'Float' argument is a basic sound duration. The default one is 0.5 (second). 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.+--+-- For better usage the 'FilePath' should be a filepath for the .wav file.+-- The third 'String' argument is used to define signs of the harmonics coefficients in the generated sounds.+-- The fourth 'String' argument is used to define the intervals for the notes if any.+-- The third 'Float' parameter basically is used to define in how many times the volume for the second lower note is less than the volume of+-- the main note. If it is rather great, it can signal that the volume for the second note overTones are greater than for the main note obetones.+-- The last one is an experimental feature.+uniqOverSoXSynthNGen4 :: FilePath -> Int -> Float -> Float -> Float -> String -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen4 file m = uniqOverSoXSynthNGen4E file m 12+{-# INLINE uniqOverSoXSynthNGen4 #-}++-- | Similar to 'uniqOverSoXSynthNGen4', but uses additional second 'Int' parameter. It defines, to which n-th elements set (see 'nkyT') belongs the obtained+-- higher notes in the intervals. If that parameter equals to 12, then the function is practically equivalent to 'uniqOverSoXSynthNGen4'. To obtain+-- its modifications, please, use 2, 3, 4, 6, or 9. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen4E file m ku ampL time3 dAmpl zs wws tts vs = do+  n <- duration1000 file+  unGenN4E4Gi n file m ku ampL dAmpl (str2DurationsDef n zs time3) wws tts vs++-- | Generalized version of the 'uniqOverSoXSynthNGen4E' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4EPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen4EPar file params ampL time3 dAmpl zs wws tts vs = do+  n <- duration1000 file+  unGenN4E4GiPar n file params ampL dAmpl (str2DurationsDef n zs time3) wws tts vs  ++-- | Variant of the 'uniqOverSoXSynthNGen4E4G' where 'Durations' are obtained from the 'String' using 'str2Durations' function. Helps to create a speech-like +-- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E4GS :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen4E4GS file m ku ampL time3 dAmpl zs wws tts vs = do+  n <- duration1000 file+  unGenN4E4Gi n file m ku ampL dAmpl (str2Durations zs time3) wws tts vs++-- | Generalized version of the 'uniqOverSoXSynthNGen4E4GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4E4GSPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen4E4GSPar file params ampL time3 dAmpl zs wws tts vs = do+  n <- duration1000 file+  unGenN4E4GiPar n file params ampL dAmpl (str2Durations zs time3) wws tts vs  ++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+unGenN4E4Gi :: Int -> FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> String -> String -> IO ()+unGenN4E4Gi n file m ku ampL dAmpl v2 wws tts vs = do+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  uniqOverSoXSynthN44G n ampL dAmpl v2 wws tts vs vecB+  endFromResult++-- | Generalized version of the 'unGenN4E4Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+unGenN4E4GiPar :: Int -> FilePath -> Params -> Float -> Float -> Durations -> String -> String -> String -> IO ()+unGenN4E4GiPar n file params ampL dAmpl v2 wws tts vs = do+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  uniqOverSoXSynthN44G n ampL dAmpl v2 wws tts vs vecB+  endFromResult  ++-- | Note that the last two 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The third 'Int' parameter defines that @n@.+unGenN4E5Gi :: Int -> FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> String -> Intervals -> IO ()+unGenN4E5Gi n file m ku ampL dAmpl v2 wws tts v3 = do+  vecA <- freqsFromFile file n+  let vecB = liftInEnkuV m ku . map fromIntegral . filter (/= (11440::Int)) $ vecA+  uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts v3 vecB+  endFromResult++-- | Generalized version of the 'unGenN4E5Gi' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+unGenN4E5GiPar :: Int -> FilePath -> Params -> Float -> Float -> Durations -> String -> String -> Intervals -> IO ()+unGenN4E5GiPar n file params ampL dAmpl v2 wws tts v3 = do+  vecA <- freqsFromFile file n+  let vecB = liftInParamsV params . map fromIntegral $ vecA+  uniqOverSoXSynthN45G n ampL dAmpl v2 wws tts v3 vecB+  endFromResult  +  +-- | 4G genaralized version of the 'uniqOverSoXSynthNGen4E' where you provide your own 'Durations'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E4G :: FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen4E4G file m ku ampL dAmpl v2 wws tts vs = do+  n <- duration1000 file+  unGenN4E4Gi n file m ku ampL dAmpl v2 wws tts vs++-- | Generalized version of the 'uniqOverSoXSynthNGen4E4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4E4GPar :: FilePath -> Params -> Float -> Float -> Durations -> String -> String -> String -> IO ()+uniqOverSoXSynthNGen4E4GPar file params ampL dAmpl v2 wws tts vs = do+  n <- duration1000 file+  unGenN4E4GiPar n file params ampL dAmpl v2 wws tts vs++-- | 5G genaralized version of the 'uniqOverSoXSynthNGen4E' where you provide your own 'Durations' and 'Intervals'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E5G :: FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> String -> Intervals -> IO ()+uniqOverSoXSynthNGen4E5G file m ku ampL dAmpl v2 wws tts v3 = do+  n <- duration1000 file+  unGenN4E5Gi n file m ku ampL dAmpl v2 wws tts v3++-- | Generalized version of the 'uniqOverSoXSynthNGen4E5G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4E5GPar :: FilePath -> Params -> Float -> Float -> Durations -> String -> String -> Intervals -> IO ()+uniqOverSoXSynthNGen4E5GPar file params ampL dAmpl v2 wws tts v3 = do+  n <- duration1000 file+  unGenN4E5GiPar n file params ampL dAmpl v2 wws tts v3  ++-- | Variant of the 'uniqOverSoXSynthNGen4E5G' where 'Intervals' are obtained from the 'String' using 'intervalsFromStringG' function. Helps to create a speech-like +-- composition. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E5GS :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> String -> Intervals -> String -> IO ()+uniqOverSoXSynthNGen4E5GS file m ku ampL time3 dAmpl zs wws tts v3 vs = do+  n <- duration1000 file+  unGenN4E5Gi n file m ku ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v3 vs)++-- | Generalized version of the 'uniqOverSoXSynthNGen4E5GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4E5GSPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> String -> Intervals -> String -> IO ()+uniqOverSoXSynthNGen4E5GSPar file params ampL time3 dAmpl zs wws tts v3 vs = do+  n <- duration1000 file+  unGenN4E5GiPar n file params ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v3 vs)  ++-- | 6G generalized function for 'uniqOverSoXSynthNGen4E5G' where you provide your own 'Strengths'. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E6G :: FilePath -> Int -> Int -> Float -> Float -> Durations -> String -> String -> Intervals -> Strengths -> Float -> IO ()+uniqOverSoXSynthNGen4E6G file m ku ampL dAmpl v2 wws tts v3 v6 limV = + uniqOverSoXSynthNGen4E5G file m ku ampL dAmpl v2 wws tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult++-- | Generalized version of the 'uniqOverSoXSynthNGen4E6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4E6GPar :: FilePath -> Params -> Float -> Float -> Durations -> String -> String -> Intervals -> Strengths -> Float -> IO ()+uniqOverSoXSynthNGen4E6GPar file params ampL dAmpl v2 wws tts v3 v6 limV = + uniqOverSoXSynthNGen4E5GPar file params ampL dAmpl v2 wws tts v3 >> apply6G2 v6 "221w" "result" limV >> endFromResult ++-- | A variant of 'uniqOverSoXSynthNGen4E6G' where 'Strengths' are obtained from a Ukrainian text specified as the last 'String' argument. Note that 'Int' arguments are used by 'liftInEnku' in that order so it +-- returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E6GS :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> String -> Intervals -> String -> +  String -> Float -> IO ()+uniqOverSoXSynthNGen4E6GS file m ku ampL time3 dAmpl zs wws tts v5 vs xxs limV = + uniqOverSoXSynthNGen4E6G file m ku ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV+{-# INLINE uniqOverSoXSynthNGen4E6GS #-} ++-- | Generalized version of the 'uniqOverSoXSynthNGen4E6GS' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4E6GSPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> String -> Intervals -> String -> +  String -> Float -> IO ()+uniqOverSoXSynthNGen4E6GSPar file params ampL time3 dAmpl zs wws tts v5 vs xxs limV = + uniqOverSoXSynthNGen4E6GPar file params ampL dAmpl (str2Durations zs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV+{-# INLINE uniqOverSoXSynthNGen4E6GSPar #-}+ +-- | A variant of 'uniqOverSoXSynthNGen4E6GS' where 'Strengths' and 'Durations' are obtained from the same Ukrainian text specified as +-- the last 'String' argument. The second 'Float' argument is an average duration of the sounds in seconds. +-- Note that 'Int' arguments are used by 'liftInEnku' in that order so it returns a 'Maybe' number (actually frequency) for +-- the n-th elements set of notes (see 'nkyT'). The second 'Int' parameter defines that @n@.+uniqOverSoXSynthNGen4E6GSu :: FilePath -> Int -> Int -> Float -> Float -> Float -> String -> String -> Intervals -> String -> String -> Float -> IO ()+uniqOverSoXSynthNGen4E6GSu file m ku ampL time3 dAmpl wws tts v5 vs xxs limV = + uniqOverSoXSynthNGen4E6G file m ku ampL dAmpl (str2Durations xxs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV+{-# INLINE uniqOverSoXSynthNGen4E6GSu #-} + +-- | Generalized version of the 'uniqOverSoXSynthNGen4E6GSu' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- use some tonality. For more information, please, refer to 'filterInParams'.+uniqOverSoXSynthNGen4E6GSuPar :: FilePath -> Params -> Float -> Float -> Float -> String -> String -> Intervals -> String -> String -> Float -> IO ()+uniqOverSoXSynthNGen4E6GSuPar file params ampL time3 dAmpl wws tts v5 vs xxs limV = + uniqOverSoXSynthNGen4E6GPar file params ampL dAmpl (str2Durations xxs time3) wws tts (intervalsFromStringG v5 vs) (str2Volume xxs) limV+{-# INLINE uniqOverSoXSynthNGen4E6GSuPar #-}
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020-2021 OleksandrZhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,19 @@+-- |+-- Module      :  Main+-- 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.++module Main where++import Composition.Sound.Executable (dobutokO2)+++{-- Main function.+--}+main :: IO ()+main = dobutokO2
+ README.markdown view
@@ -0,0 +1,287 @@+Rewritten from the dobutokO2 package on Hackage (https://hackage.haskell.org/package/dobutokO2)+using arrays and lists instead of vector-related functionality.+++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.+++                ***** Usage *****+                =================++You can use it as a library or as an executable.++Please, check before executing whether there is no "x.wav", "test\*.wav",+"result\*.wav" and "end.wav" files in the current directory, because they+can be overwritten. The same can be said about "nx\*.wav" files in the directory.++For the executable you enter in the terminal:++acb { 0 | 1 | 11 | 2 | 21 | 3 | 31 | 4 | 41 | 5 | 51 | 6 | 7 } {fileName} {Ukrainian text}++OR:++acb { 8 | 80 | 9 | 99 | 999 }++OR:++acb { 82 | 820 | 92 | 992 | 9992 } {volatile symbols together, e. g. "0"} {quality control, see information below}++OR:++acb { 00 | 002 } {beginning symbols for the filenames "fade" effect to be applied to} {quality control, see information below}++  where filename is:+  the full name of the file to be recorded in the current directory or+  the full absolute path to the sound .wav file (or other one format+  that is supported by your SoX installation) to obtain sound information from.++If the first command line argument equals to one of the numbers below, then+the program behaves as follows:++  "1", or "3", or "5" ->  then the executable uses the overTones functions,+    so for the given parameters the overtones are the same for every call.++  "2", or "4", or "6" -> then the program uses uniqOverTones functions.++  "3", or "4", or "5", or "6" -> the program uses additional String to define+    signs for the harmonics coefficients for overtones.++  "11", or "21", or "31", or "41", or "51", or "61" -> the program works as for+     the respective inputs with only the first character in the option+       (e. g. for "51", this is "5"), but uses not octaves, but n-th elements sets+         of consequential notes consisting of 2, 3, 4, 6, or 9 elements (called+           'enky'). The usual octave is from such point of view a 12th elements set+             of consequential notes. This allows to create more 'condensed' and+               'narrower' compositions that being more defined can be at the+                 same time more precise.++  "9" -> the program works with existing "result\*.wav" files and you can replace+     some of them by other one(s) or their sequences. This allows to create files,+       then edit them using this first command line option (possibly for several+         times) and at last create a resulting melody file with "8" or "80" options.++  "99" -> the program takes a filename (it is a first command line argument and it is+     ignored) and the rest of the command line argument (they are treated as command+       line arguments to the SoX 'play' command). Then the program prompts you to+         specify the needed indeces for the "result\*.wav" files in the current+           directory (e. g. they can be obtained by executing the acb with+             the first command line argument less than "8", or produced by some+               other means). You can specify multiple lists of Int to select the+                 needed files to be played with effects. Afterwards, the program+                   just plays these selected files applying the specified SoX+                     effects to them consequently. For example:+    acb 9 reverb -w+                       will play the selected (during execution) files with the+                         SoX "reverb -w" effect. For more information on effects,+                           please, refer to the SoX documentation.++  "999" -> similarly to "99", but instead of playing the files, SoX actually+      applies to them these effects and overwrites the files with the obtained ones.+        It is convenient way to test the sounding effects with firstly run the+          acb with "99" first command line argument, and then, if suitable,+            with "999" one. Be aware, that after running with the latter one, the+              program cannot restore the files that were changed to their previous+                state, so be careful while running.+                           +  In more details:++  "0" -> the program just converts multiline Ukrainian text from stdin+     into a String and prints it to stdout. No other arguments are used.++  "00" -> the program applies "fade q 0.01 -0.0" SoX effect to every "zs\*.wav"+     (or instead of them to every "zs\*.flac") file in the current directory. +       The 'zs' here is specified by the second command line argument.+        This allows to avoid clipping while just simply concatenating the files into+          one with SoX. The mentioned clipping can be desirable in some circumstances+            but generally is not necessary or is redundant. For more information,+              please, refer to the SoX documentation and to that one for 'fadeAllE'+                function in the Composition.Sound.IntermediateF module.+                +  "002" -> the program applies "fade q 0.002 -0.0" SoX effect to every "zs\*.wav"+     (or instead of them to every "zs\*.flac") file in the current directory. +       Works similarly to the option "00" (see above).++  "1" -> basic functionality without the possibility to define individual overtones.++  "11" -> the same as "1", but works with enky. See general information above.+  +  "2" -> basic functionality with the possibility to define individual overtones.+     In such a case, another text gives the other overtones.++  "21" -> the same as "2", but works with enky. See general information above.++  "3" -> adittionally to basic functionality gives an opportunity +     to specify the signs for the harmonics coefficients for overtones+       by additional String.++  "31" -> the same as "3", but works with enky. See general information above.++  "4" -> similarly to "2" gives an opportunity to specify the signs+     for the harmonics coefficients for overtones by additional String.++  "41" -> the same as "4", but works with enky. See general information above.++  "5" -> additionally to that one functionality provided by "3" gives+     an opportunity to specify in how many times the amplitude for+       the second lower note (if any) is greater, than the amplitude+         for the main note and specify the intervals to be used+           for every note.++  "51" -> the same as "5", but works with enky. See general information above.++  "6" -> the same as "5", but you can define also overtones by an additional String.++  "61" -> the same as "6", but works with enky. See general information above.++  "7" -> the program behaves like for the "5" option, but generates+     overtones using additional String and allows maximum control over+       the parameters. Besides, all the needed information it obtains from+         the singular formatted input, which can be ended with a keyboard keys+           combination that means an end of input (e. g. for Unices, that is+             probably Ctrl + D). '@' are separators for the input parts+               for their respective parts. For more information about the+                 format of the single input, see:+        https://drive.google.com/open?id=10Z_GRZR4TKoL5KXfqPm-t-4humuHN0O4+                  The file is also provided with the package as text.dat.txt.+                   The last two or three inputs (an input just here means+                     a textual input between two '@') can be omitted, the+                       program will work also but with less control for+                         the user possible.++   "8" -> the program just creates from input "result\*" files the "end.wav" by+     concatenating them into one. It is mostly useful after some processment+       on the "result\*" files after previous execution with other lesser first+         command line arguments to get the test final sound file. It can be then+           listened to and probably remade again by editing the "result\*" files+             and running the program with this option again. In such a case,+               none from the other command line arguments is important for the+                 program running, so they all can be simply omitted.++   "80" -> the same as "8" but with one important difference that the program if+     succeeded in creation of the "end.wav" file, then removes all other "result\*"+       files from the current directory, so you cannot reverse the successful action+         back and try again with just the same files. In such a case, you need to+           repeat all the process of creation of "result\*" files. Be aware and use+             with care!++  "82" -> the same as "8", but you can specify the sound quality parameters for the+     resulted file and choose whether it will be in WAV or FLAC format. To specify+       this additional processing information, use as a third command line argument+          (after the first "82" and the volatile second one) 4 consequent symbols:+            3 digits and 1 letter ('f' -- for FLAC one and 'w' for WAV one). The first+              two digits are a code for rate and the third one -- a code for bit depth+                ('1' -- for 16 bit and '2' -- for 24 bit). The list of possible first+                  two digits and their corresponding frequency rate in Hz:++                     "11" -> 11025++                     "16" -> 16000++                     "17" -> 176400++                     "19" -> 192000++                     "32" -> 32000++                     "44" -> 44100++                     "48" -> 48000++                     "80" -> 8000++                     "96" -> 96000++                     The default one behaviour is equivalent to "221w".++  "820" -> the same as "80", but similarly to "82" it gives you the opportunity to+      specify sound quality parameters in just the same way.++  "9", "99", or "999" -> see the information above.++  "92", "992", or "9992" -> similar to the above line, but with the opportunity to+      specify sound quality parameters in just the same way as for "82" option.+         These are considered still highly experimental and not well tested,+            so use them not for production.+           +   _  -> the program behaves like for the "5" option, but generates+     overtones using additional String and allows maximum control over+        the parameters.++After the program executing (it takes some time) with the first command line+options except "80" there are files "result\*.wav" in the directory.+These are the resulting melody generated in their order preserved.++The program now lifts the frequencies to the octave or to the enka with the number,+which you can specify during its execution.++You can use the default values by simply pressing 'Enter' while being prompted and+the informational message contains the line about the default value.++The package extends its library functions with+the possibility to create not only single notes or intervals of sounds playing+simultaneously but also sets of three, four, five, six, seven or more sounds+played simultaneously with their overtones. For more information, please, refer+to the documentation for the Composition.Sound.Functional module.++The library functions are extended also with the+possibility to adjust volume for the overtones using generalized functions '1G'+with adjustment being represented in dB. For more information, please, refer+to the documentation for the Composition.Sound.Functional module.++The library includes functions '2G': generalized+ones in the Composition.Sound.Functional, and Composition.Sound.IntermediateF, and+Composition.Sound.Executable modules. They allow to specify sound quality+of the resulting files using additional parameter.++The library includes functions to work more explicitly+with f function in the Composition.Sound.Functional module. They are based on the+simplest (but still meaningful) multiplicative data fitting.++The library includes functions to split the sound +into several simultaneously sounding similar ones. For more information, please, +refer to the Composition.Sound.Functional module.++The library includes functions to provide your own +variants of durations, intervals and volume adjustments and the possibilities +to generate speech-like music with most of parameters obtained from the Ukrainian +language texts.++The library includes new datatype Params in the +Composition.Sound.Functional module and various functions to work with it. It +allows to use tonalities or something close to them. For more information, +please, refer to Composition.Sound.Functional submodules.++There are some additional effects and opportunities +in the Composition.Sound.Functional and Composition.Sound.IntermediateF modules. Some +functions in the library were moved from the Composition.Sound.Executable module +to the Composition.Sound.Functional module because of logics of the module structure +and semantics.++** Note:++* Better to execute in the RAM. Need rather a lot of space on the disk for+the resulting file "end.wav" and auxiliary files (MBs) for a short sound+in the second command line arguments.++                ***** Examples *****+                ====================++You can refer to examples in the GitHub special+repository (https://github.com/OleksandrZhabenko/dobutokO2-examples/) for the+previously created dobutokO2 and dobutokO3 packages. +You can also see some of the generated sounds on the YouTube list:+https://www.youtube.com/playlist?list=PLuG3zSZWV7yollV9nMPcRtm3udVuYVlFS+++                ***** Support for not Sound File Variativity Sources *****+                ==========================================================+                +The library supports not only the sound file as a +variativity source but also other types of files. They are used through +a special reencoding using lazy bytestrings. For more information, please, +refer to Composition.Sound.Keyboard module.                ++The library uses Float instead of Double where possible. Double precision +is redundant. The shift is inspired by: https://www.youtube.com/watch?v=FYTZkE5BZ-0+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ algorithmic-composition-basic.cabal view
@@ -0,0 +1,34 @@+-- Initial algorithmic-composition-basic.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                algorithmic-composition-basic+version:             0.1.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+license:             MIT+license-file:        LICENSE+author:              OleksandrZhabenko+maintainer:          olexandr543@yahoo.com+copyright:           Oleksandr Zhabenko+category:            Sound, Music, Language+build-type:          Simple+extra-source-files:  CHANGELOG.md, README.markdown, text.dat.txt+cabal-version:       >=1.10++library+  exposed-modules:     Main, Composition.Sound.Overtones, Composition.Sound.Uniq, Composition.Sound.Functional, Composition.Sound.Process, Composition.Sound.Executable, Composition.Sound.IntermediateF, Composition.Sound.ParseList, Composition.Sound.Keyboard, Composition.Sound.Functional.Basics, Composition.Sound.Functional.Params, Composition.Sound.Functional.Split, Composition.Sound.DIS5G6G, Composition.Sound.Functional.Elements, Composition.Sound.Decibel, Composition.Sound.Extended, Composition.Sound.Octaves, Composition.Sound.FunctionF+  -- other-modules:+  -- other-extensions:+  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+  -- hs-source-dirs:+  default-language:    Haskell2010++executable acb+  main-is:             Main.hs+  other-modules:       Composition.Sound.Overtones, Composition.Sound.Uniq, Composition.Sound.Functional, Composition.Sound.Process, Composition.Sound.Executable, Composition.Sound.IntermediateF, Composition.Sound.ParseList, Composition.Sound.Keyboard, Composition.Sound.Functional.Basics, Composition.Sound.Functional.Params, Composition.Sound.Functional.Split, Composition.Sound.DIS5G6G, Composition.Sound.Functional.Elements, Composition.Sound.Decibel, Composition.Sound.Extended, Composition.Sound.Octaves, Composition.Sound.FunctionF+  -- other-extensions:+  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+  -- hs-source-dirs:+  default-language:    Haskell2010+
+ text.dat.txt view
@@ -0,0 +1,13 @@+5+@+69+@+0.39+@+ Тестовий ввід данних, які будуть використані для створення композиції.+@+ Тестовий ввід данних, які будуть використані для створення композиції.+@+0.67+@+ Тестовий ввід данних, які будуть використані для створення композиції.