-- |
-- Module      :  DobutokO.Sound.Functional
-- Copyright   :  (c) OleksandrZhabenko 2020, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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 DobutokO.Sound.Functional (
  -- * Use additional function as a parameter
  overSoXSynth2FDN
  , overSoXSynth2FDN_B
  -- ** Just simple function application
  , overSoXSynth2FDN_S
  -- *** With additional filtering
  , overSoXSynth2FDN_Sf
  , overSoXSynth2FDN_Sf3
  -- * Use additional function and Ukrainian texts and generates melody
  , overSoXSynthGen2FDN
  , overSoXSynthGen2FDN_B
  , overSoXSynthGen2FDN_S
  , overSoXSynthGen2FDN_Sf
  , overSoXSynthGen2FDN_Sf3
  -- * 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
  , soundGenF3
  , 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
) where

import Numeric
import Data.List (nubBy)
import Data.Maybe (isNothing,fromJust,fromMaybe,maybe)
import qualified Data.Vector as V
import System.Process
import EndOfExe2
import System.Directory
import Aftovolio.Ukrainian.Melodics (convertToProperUkrainianI8)
import DobutokO.Sound.IntermediateF
import DobutokO.Sound.Functional.Basics
import DobutokO.Sound.Functional.Params
import DobutokO.Sound.DIS5G6G (intervalsFromStringG,str2Durations,str2Vol1,str2Volume)

-- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Float -> Vector (Float, Float)@ with
-- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' 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
-- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. '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 :: (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs = (Float -> OvertonesO)
-> (Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN1G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs (Int -> Float -> Vector Float
forall a. Int -> a -> Vector a
V.replicate (OvertonesO -> Int
forall a. Vector a -> Int
V.length (OvertonesO -> Int) -> (Float -> OvertonesO) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> OvertonesO) -> (Float -> Float) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
closestNote (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 
  then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0) Float
0.0)

-- | 'V.Vector' of 'Float' is a vector of dB volume adjustments for the corresponding harmonices (overtones).
overSoXSynth2FDN1G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> V.Vector Float -> IO ()
overSoXSynth2FDN1G :: (Float -> OvertonesO)
-> (Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN1G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs Vector Float
vdB = (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN2G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs Vector Float
vdB []
 
-- | 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN2G :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN2G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs Vector Float
vdB [Char]
ys
 | [Sound8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Sound8] -> Bool) -> ([Char] -> [Sound8]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Sound8]
convertToProperUkrainianI8 ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
zs = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        l0 :: Int
l0     = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
zs
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex ([Char] -> Vector Int
intervalsFromString [Char]
zs) (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        g0 :: Float -> OvertonesO
g0    = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (Float -> [(Float, Float)]) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Bool)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(!Float
x1,Float
_) (!Float
x2,Float
_) -> Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x2) ([(Float, Float)] -> [(Float, Float)])
-> (Float -> [(Float, Float)]) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> (Float -> OvertonesO) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
noteX, !Float
amplX) ->
           if Float
noteX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note0, Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX))) else (Float -> Float
closestNote Float
noteX,
             Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX)))) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f
        g :: Float -> OvertonesO
g Float
k   = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 Float
k) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
k 
        v0 :: OvertonesO
v0    = Float -> OvertonesO
g Float
note0
        v1 :: OvertonesO
v1    = OvertonesO -> (Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OvertonesO
forall a. Vector a
V.empty Float -> OvertonesO
g Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
"" 
        overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"test0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
"" else [Char]
"0"]) [Char]
"")
        overSoXSynthHelp2 :: Vector (a, a) -> Vector Float -> IO ()
overSoXSynthHelp2 Vector (a, a)
vec Vector Float
vdB = (Int -> (a, a) -> IO (ExitCode, [Char], [Char]))
-> Vector (a, a) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (a
noteN, !a
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) ([[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]
"-r22050", [Char]
"-n", [Char]
"test1" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
noteN [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
amplN [Char]
"" else [Char]
"0"] (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) [Char]
"") Vector (a, a)
vec
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts, 
       [Char]
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT then "1.0" else "0"]) ""
      overSoXSynthHelp v0
      overSoXSynthHelp2 v1 vdB
    if null ys then mixTest else mixTest2G ys   

-- | 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN5G :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN5G Float -> OvertonesO
f (Float
x, Float
y) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys
 | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        l0 :: Int
l0     = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        g0 :: Float -> OvertonesO
g0    = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (Float -> [(Float, Float)]) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Bool)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(!Float
x1,Float
_) (!Float
x2,Float
_) -> Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x2) ([(Float, Float)] -> [(Float, Float)])
-> (Float -> [(Float, Float)]) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> (Float -> OvertonesO) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
noteX, !Float
amplX) ->
           if Float
noteX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note0, Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX))) else (Float -> Float
closestNote Float
noteX,
             Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX)))) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f
        g :: Float -> OvertonesO
g Float
k   = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 Float
k) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
k 
        v0 :: OvertonesO
v0    = Float -> OvertonesO
g Float
note0
        v1 :: OvertonesO
v1    = OvertonesO -> (Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OvertonesO
forall a. Vector a
V.empty Float -> OvertonesO
g Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
"" 
        overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"test0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
"" else [Char]
"0"]) [Char]
"")
        overSoXSynthHelp2 :: Vector (a, a) -> Vector Float -> IO ()
overSoXSynthHelp2 Vector (a, a)
vec Vector Float
vdB = (Int -> (a, a) -> IO (ExitCode, [Char], [Char]))
-> Vector (a, a) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (a
noteN, !a
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) ([[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]
"-r22050", [Char]
"-n", [Char]
"test1" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
noteN [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
amplN [Char]
"" else [Char]
"0"] (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) [Char]
"") Vector (a, a)
vec
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts, 
       [Char]
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT then "1.0" else "0"]) ""
      overSoXSynthHelp v0
      overSoXSynthHelp2 v1 vdB
    if null ys then mixTest else mixTest2G ys       

-- | Generalized variant of the 'overSoXSynth2FDN5G' with afterwards 'apply6Gf' usage. 
overSoXSynth2FDN6G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> Intervals -> V.Vector Float -> String -> Float -> IO ()
overSoXSynth2FDN6G :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN6G Float -> OvertonesO
f (Float
x, Float
y) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys Float
vol
 | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        l0 :: Int
l0     = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        g0 :: Float -> OvertonesO
g0    = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (Float -> [(Float, Float)]) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Bool)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(!Float
x1,Float
_) (!Float
x2,Float
_) -> Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x2) ([(Float, Float)] -> [(Float, Float)])
-> (Float -> [(Float, Float)]) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> (Float -> OvertonesO) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
noteX, !Float
amplX) ->
           if Float
noteX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note0, Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX))) else (Float -> Float
closestNote Float
noteX,
             Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX)))) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f
        g :: Float -> OvertonesO
g Float
k   = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 Float
k) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
k 
        v0 :: OvertonesO
v0    = Float -> OvertonesO
g Float
note0
        v1 :: OvertonesO
v1    = OvertonesO -> (Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OvertonesO
forall a. Vector a
V.empty Float -> OvertonesO
g Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
"" 
        overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"test0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
"" else [Char]
"0"]) [Char]
"")
        overSoXSynthHelp2 :: Vector (a, a) -> Vector Float -> IO ()
overSoXSynthHelp2 Vector (a, a)
vec Vector Float
vdB = (Int -> (a, a) -> IO (ExitCode, [Char], [Char]))
-> Vector (a, a) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (a
noteN, !a
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) ([[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]
"-r22050", [Char]
"-n", [Char]
"test1" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
noteN [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
amplN [Char]
"" else [Char]
"0"] (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) [Char]
"") Vector (a, a)
vec
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts, 
       [Char]
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT then "1.0" else "0"]) ""
      overSoXSynthHelp v0
      overSoXSynthHelp2 v1 vdB
    if null ys then mixTest else mixTest2G ys
    if compare y 0.0 == GT 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 -> V.Vector Float -> String -> String -> IO ()
overSoXSynth2FDN6GS :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> [Char]
-> Vector Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynth2FDN6GS Float -> OvertonesO
f (Float
x, Float
y) Int
j Vector Int
v5 [Char]
xs Vector Float
vdB [Char]
ys [Char]
xxs 
 | [Sound8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Sound8] -> Bool) -> ([Char] -> [Sound8]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Sound8]
convertToProperUkrainianI8 ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
xxs = [Char] -> IO ()
putStrLn [Char]
"You provided no information to obtain volume adjustment! "
 | Bool
otherwise = (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN6G Float -> OvertonesO
f (Float
x, Float
y) Int
j (Vector Int -> [Char] -> Vector Int
intervalsFromStringG Vector Int
v5 [Char]
xs) Vector Float
vdB [Char]
ys ([Char] -> Float
str2Vol1 [Char]
xxs)
 
-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynthGen2FDN [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Vector Float
-> [Char]
-> IO ()
overSoXSynthGen2FDN4G [Char]
file Int
m Int
ku Float -> OvertonesO
f Vector Float
v2 [Char]
wws = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Vector Float
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG4G [Char]
file Int
m Int
ku Float -> OvertonesO
f Vector Float
v2 [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN

-- | Similar to 'overSoXSynth2DN' but instead of 'overTones' function, it uses volatile function @f::Float -> Vector (Float, Float)@ with
-- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' 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
-- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. 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 :: (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN_B Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j [Char]
zs = (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN_B1G Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j [Char]
zs (Int -> Float -> Vector Float
forall a. Int -> a -> Vector a
V.replicate (OvertonesO -> Int
forall a. Vector a -> Int
V.length (OvertonesO -> Int) -> (Float -> OvertonesO) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> OvertonesO) -> (Float -> Float) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
closestNote (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0) Float
0.0)

-- | 'V.Vector' of 'Float' is a vector of dB volume adjustments for the corresponding harmonices (overtones).
overSoXSynth2FDN_B1G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> V.Vector Float -> IO ()
overSoXSynth2FDN_B1G :: (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN_B1G Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j [Char]
zs Vector Float
vdB = (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_B2G Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j [Char]
zs Vector Float
vdB []

-- | 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN_B2G :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_B2G Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j [Char]
zs Vector Float
vdB [Char]
ys
 | [Sound8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Sound8] -> Bool) -> ([Char] -> [Sound8]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Sound8]
convertToProperUkrainianI8 ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
zs = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let limA0 :: Float
limA0 = Float -> Float
forall a. Num a => a -> a
abs ((Float
limB Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ (Float
limB Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10))) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
10
        limA :: Float
limA  = if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
limA0 Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float
limA0
        l0 :: Int
l0    = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
zs
        note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex ([Char] -> Vector Int
intervalsFromString [Char]
zs) (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        g0 :: Float -> OvertonesO
g0    = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (Float -> [(Float, Float)]) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Bool)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(!Float
x1,Float
_) (!Float
x2,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x2)) Float
limA Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) ([(Float, Float)] -> [(Float, Float)])
-> (Float -> [(Float, Float)]) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> (Float -> OvertonesO) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
noteX, !Float
amplX) ->
           if Float
noteX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note0, Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX))) else (Float -> Float
closestNote Float
noteX,
             Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX)))) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f
        v0 :: OvertonesO
v0    = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 Float
note0) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
note0 
        v1 :: OvertonesO
v1    = if Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Float
note1 then OvertonesO
forall a. Vector a
V.empty
                else ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 (Float -> OvertonesO)
-> (Maybe Float -> Float) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Maybe Float
note1) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO)
-> (Maybe Float -> Float) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
"" 
        overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"test0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
"" else [Char]
"0"]) [Char]
"")
        overSoXSynthHelp2 :: Vector (a, a) -> Vector Float -> IO ()
overSoXSynthHelp2 Vector (a, a)
vec Vector Float
vdB = (Int -> (a, a) -> IO (ExitCode, [Char], [Char]))
-> Vector (a, a) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (a
noteN, !a
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) ((if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
vdB then [[Char]] -> [[Char]]
forall a. a -> a
id else (\[[Char]]
wwws -> [[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]]
wwws (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) 
              [[Char]
"-r22050", [Char]
"-n", [Char]
"test1" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
noteN [Char]
"", [Char]
"vol", 
                if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
amplN [Char]
"" else [Char]
"0"])) [Char]
"") Vector (a, a)
vec
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts,[Char]
"sine",
       Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT then "1.0" else "0"]) ""
      overSoXSynthHelp v0
      overSoXSynthHelp2 v1 vdB
    if null ys then mixTest else mixTest2G ys    

-- | 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN_B5G :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_B5G Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys
 | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let limA0 :: Float
limA0 = Float -> Float
forall a. Num a => a -> a
abs ((Float
limB Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ (Float
limB Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10))) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
10
        limA :: Float
limA  = if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
limA0 Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float
limA0
        l0 :: Int
l0    = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
        note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        g0 :: Float -> OvertonesO
g0    = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (Float -> [(Float, Float)]) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Bool)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(!Float
x1,Float
_) (!Float
x2,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x2)) Float
limA Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) ([(Float, Float)] -> [(Float, Float)])
-> (Float -> [(Float, Float)]) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> (Float -> OvertonesO) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
noteX, !Float
amplX) ->
           if Float
noteX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note0, Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX))) else (Float -> Float
closestNote Float
noteX,
             Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX)))) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f
        v0 :: OvertonesO
v0    = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 Float
note0) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
note0 
        v1 :: OvertonesO
v1    = if Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Float
note1 then OvertonesO
forall a. Vector a
V.empty
                else ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 (Float -> OvertonesO)
-> (Maybe Float -> Float) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Maybe Float
note1) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO)
-> (Maybe Float -> Float) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
"" 
        overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"test0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
"" else [Char]
"0"]) [Char]
"")
        overSoXSynthHelp2 :: Vector (a, a) -> Vector Float -> IO ()
overSoXSynthHelp2 Vector (a, a)
vec Vector Float
vdB = (Int -> (a, a) -> IO (ExitCode, [Char], [Char]))
-> Vector (a, a) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (a
noteN, !a
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) ((if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
vdB then [[Char]] -> [[Char]]
forall a. a -> a
id else (\[[Char]]
wwws -> [[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]]
wwws (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) 
              [[Char]
"-r22050", [Char]
"-n", [Char]
"test1" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
noteN [Char]
"", [Char]
"vol", 
                if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
amplN [Char]
"" else [Char]
"0"])) [Char]
"") Vector (a, a)
vec
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts,[Char]
"sine",
       Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT then "1.0" else "0"]) ""
      overSoXSynthHelp v0
      overSoXSynthHelp2 v1 vdB
    if null ys then mixTest else mixTest2G ys    

-- | Generalized variant of the 'overSoXSynth2FDN_B5G' with afterwards 'apply6G' usage. 
overSoXSynth2FDN_B6G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> V.Vector Float -> String -> Float -> IO ()
overSoXSynth2FDN_B6G :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN_B6G Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys Float
vol 
  | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
  | Bool
otherwise = do
    let limA0 :: Float
limA0 = Float -> Float
forall a. Num a => a -> a
abs ((Float
limB Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10) Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ (Float
limB Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10))) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
10
        limA :: Float
limA  = if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
limA0 Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float
limA0
        l0 :: Int
l0    = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
        note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        g0 :: Float -> OvertonesO
g0    = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (Float -> [(Float, Float)]) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Bool)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(!Float
x1,Float
_) (!Float
x2,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x2)) Float
limA Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) ([(Float, Float)] -> [(Float, Float)])
-> (Float -> [(Float, Float)]) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> (Float -> OvertonesO) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
noteX, !Float
amplX) ->
           if Float
noteX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.0 then (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note0, Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX))) else (Float -> Float
closestNote Float
noteX,
             Float -> Float
forall a. Num a => a -> a
abs (Float
amplX Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
amplX)))) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f
        v0 :: OvertonesO
v0    = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 Float
note0) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
note0 
        v1 :: OvertonesO
v1    = if Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Float
note1 then OvertonesO
forall a. Vector a
V.empty
                else ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,!Float
z0) -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex (Float -> OvertonesO
g0 (Float -> OvertonesO)
-> (Maybe Float -> Float) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Maybe Float
note1) (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0), Float
z0)) (OvertonesO -> OvertonesO)
-> (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
g0 (Float -> OvertonesO)
-> (Maybe Float -> Float) -> Maybe Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
"" 
        overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"test0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", 
              Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
"" else [Char]
"0"]) [Char]
"")
        overSoXSynthHelp2 :: Vector (a, a) -> Vector Float -> IO ()
overSoXSynthHelp2 Vector (a, a)
vec Vector Float
vdB = (Int -> (a, a) -> IO (ExitCode, [Char], [Char]))
-> Vector (a, a) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (a
noteN, !a
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
            ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) ((if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
vdB then [[Char]] -> [[Char]]
forall a. a -> a
id else (\[[Char]]
wwws -> [[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]]
wwws (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) 
              [[Char]
"-r22050", [Char]
"-n", [Char]
"test1" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
ts,[Char]
"sine", Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
noteN [Char]
"", [Char]
"vol", 
                if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
amplN [Char]
"" else [Char]
"0"])) [Char]
"") Vector (a, a)
vec
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts,[Char]
"sine",
       Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT then "1.0" else "0"]) ""
      overSoXSynthHelp v0
      overSoXSynthHelp2 v1 vdB
    if null ys then mixTest else mixTest2G ys    
    if compare y 0.0 == GT then apply6Gf vol ("result." ++ if drop 3 ys == "f" then "flac" else "wav") else putStr ""

-- | 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 -> V.Vector Float -> String -> String -> IO ()
overSoXSynth2FDN_B6GS :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> [Char]
-> Vector Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynth2FDN_B6GS Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j Vector Int
v5 [Char]
xs Vector Float
vdB [Char]
ys [Char]
xxs
 | [Sound8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Sound8] -> Bool) -> ([Char] -> [Sound8]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Sound8]
convertToProperUkrainianI8 ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
xxs = [Char] -> IO ()
putStrLn [Char]
"You provided no information to obtain volume adjustment! "
 | Bool
otherwise = (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN_B6G Float -> OvertonesO
f (Float
x, Float
y, Float
limB) Int
j (Vector Int -> [Char] -> Vector Int
intervalsFromStringG Vector Int
v5 [Char]
xs) Vector Float
vdB [Char]
ys ([Char] -> Float
str2Vol1 [Char]
xxs)

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynthGen2FDN_B [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y Float
limB [Char]
zs [Char]
wws = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_Sf3G [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y Float
limB [Char]
zs [Char]
wws (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN_B

-- | Similar to 'overSoXSynth2FDN' but it does not make any normalizing transformations with the 'V.Vector' argument. To be used properly, it is needed
-- that every second element in the tuple in the 'V.Vector' 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_S :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
overSoXSynth2FDN_S :: (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN_S Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs = (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_S2G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs Vector Float
forall a. Vector a
V.empty []

-- | Generalized version of the 'overSoXSynth2FDN_S' with the additional volume adjustment in dB for overtones given by 'V.Vector' of 'Float'.
overSoXSynth2FDN_S1G :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> V.Vector Float -> IO ()
overSoXSynth2FDN_S1G :: (Float -> OvertonesO)
-> (Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN_S1G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs Vector Float
vdB = (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_S2G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs Vector Float
vdB []
 
-- | 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN_S2G :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_S2G Float -> OvertonesO
f (Float
x, Float
y) Int
j [Char]
zs Vector Float
vdB [Char]
ys
 | [Sound8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Sound8] -> Bool) -> ([Char] -> [Sound8]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Sound8]
convertToProperUkrainianI8 ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
zs = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        l0 :: Int
l0    = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
zs
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex ([Char] -> Vector Int
intervalsFromString [Char]
zs) (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        v0 :: OvertonesO
v0    = Float -> OvertonesO
f Float
note0
        v1 :: OvertonesO
v1    = OvertonesO -> (Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OvertonesO
forall a. Vector a
V.empty Float -> OvertonesO
f Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
""
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts,[Char]
"sine",
       Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN_S5G :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_S5G Float -> OvertonesO
f (Float
x, Float
y) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys
 | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        l0 :: Int
l0    = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        v0 :: OvertonesO
v0    = Float -> OvertonesO
f Float
note0
        v1 :: OvertonesO
v1    = OvertonesO -> (Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OvertonesO
forall a. Vector a
V.empty Float -> OvertonesO
f Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
""
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts,[Char]
"sine",
       Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT 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 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 -> V.Vector Float -> String -> Float -> IO ()
overSoXSynth2FDN_S6G :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN_S6G Float -> OvertonesO
f (Float
x, Float
y) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys Float
vol
 | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let note0 :: Float
note0 = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
        l0 :: Int
l0    = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
        note1 :: Maybe Float
note1 = Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) Float
note0
        v0 :: OvertonesO
v0    = Float -> OvertonesO
f Float
note0
        v1 :: OvertonesO
v1    = OvertonesO -> (Float -> OvertonesO) -> Maybe Float -> OvertonesO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OvertonesO
forall a. Vector a
V.empty Float -> OvertonesO
f Maybe Float
note1
        ts :: [Char]
ts = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Float -> Float
forall a. Num a => a -> a
abs Float
y) [Char]
""
    _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) [[Char]
"-r22050", [Char]
"-n", [Char]
"testA.wav", [Char]
"synth", [Char]
ts,[Char]
"sine",
       Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"",[Char]
"vol", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [Char]
"1.0" else [Char]
"0"]) [Char]
""
    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 compare y 0.0 == GT 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            
    if compare y 0.0 == GT 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 -> V.Vector Float -> String -> String -> IO ()
overSoXSynth2FDN_S6GS :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> [Char]
-> Vector Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynth2FDN_S6GS Float -> OvertonesO
f (Float
x, Float
y) Int
j Vector Int
v5 [Char]
xs Vector Float
vdB [Char]
ys [Char]
xxs
 | [Sound8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Sound8] -> Bool) -> ([Char] -> [Sound8]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Sound8]
convertToProperUkrainianI8 ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
xxs = [Char] -> IO ()
putStrLn [Char]
"You provided no information to obtain volume adjustment! "
 | Bool
otherwise = (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN_S6G Float -> OvertonesO
f (Float
x, Float
y) Int
j (Vector Int -> [Char] -> Vector Int
intervalsFromStringG Vector Int
v5 [Char]
xs) Vector Float
vdB [Char]
ys ([Char] -> Float
str2Vol1 [Char]
xxs)

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h = do
  n <- [Char] -> IO Int
duration1000 [Char]
file
  overSoXSynthGen2FDN_SG4G file m ku f (str2DurationsDef n zs y) wws h

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Vector Float
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG4G [Char]
file Int
m Int
ku Float -> OvertonesO
f Vector Float
v2 [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h = do
  n <- [Char] -> IO Int
duration1000 [Char]
file
  vecA <- freqsFromFile file n
  let vecB = Int -> Int -> Vector Float -> Vector Float
liftInEnkuV Int
m Int
ku (Vector Float -> Vector Float)
-> (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Vector Float)
-> (Vector Int -> Vector Int) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Vector Int -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
11440::Int)) (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> a -> b
$ Vector Int
vecA
      zeroN = Vector Float -> Int
forall a. Vector a -> Int
numVZeroesPre Vector Float
vecB in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h Float -> OvertonesO
f (Float
x, (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v2)))) Int
j [Char]
wws
        [Char] -> [Char] -> IO ()
renameFile [Char]
"result.wav" ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"result0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav") 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG4GS [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Vector Float
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG4G [Char]
file Int
m Int
ku Float -> OvertonesO
f ([Char] -> Float -> Vector Float
str2Durations [Char]
zs Float
y)

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Vector Float
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> Vector Float
-> Float
-> IO ()
overSoXSynthGen2FDN_SG6G [Char]
file Int
m Int
ku Float -> OvertonesO
f Vector Float
v2 [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h Vector Float
v6 Float
limV
 | Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v6 = [Char] -> IO ()
putStrLn [Char]
"You did not provide a volume adjustments vector! "
 | Bool
otherwise = do
    n <- [Char] -> IO Int
duration1000 [Char]
file
    vecA <- freqsFromFile file n
    let vecB = Int -> Int -> Vector Float -> Vector Float
liftInEnkuV Int
m Int
ku (Vector Float -> Vector Float)
-> (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Vector Float)
-> (Vector Int -> Vector Int) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Vector Int -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
11440::Int)) (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> a -> b
$ Vector Int
vecA
        zeroN = Vector Float -> Int
forall a. Vector a -> Int
numVZeroesPre Vector Float
vecB in V.imapM_ (\Int
j Float
x -> do
          (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h Float -> OvertonesO
f (Float
x, (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v2)))) Int
j [Char]
wws
          [Char] -> [Char] -> IO ()
renameFile [Char]
"result.wav" ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"result0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav"
          [Char] -> Float -> Float -> IO ()
apply6GSilentFile ([Char]
"result0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav") Float
limV (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v6 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v6))) 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> [Char]
-> Float
-> IO ()
overSoXSynthGen2FDN_SG6GS [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h [Char]
zzs = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Vector Float
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> Vector Float
-> Float
-> IO ()
overSoXSynthGen2FDN_SG6G [Char]
file Int
m Int
ku Float -> OvertonesO
f ([Char] -> Float -> Vector Float
str2Durations [Char]
zs Float
y) [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h ([Char] -> Vector Float
str2Volume [Char]
zzs)  

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> Float
-> IO ()
overSoXSynthGen2FDN_SG6GSu [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Vector Float
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> Vector Float
-> Float
-> IO ()
overSoXSynthGen2FDN_SG6G [Char]
file Int
m Int
ku Float -> OvertonesO
f ([Char] -> Float -> Vector Float
str2Durations [Char]
zs Float
y) [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
h ([Char] -> Vector Float
str2Volume [Char]
zs)

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> [Char] -> IO ())
-> [Char]
-> IO ()
overSoXSynthGen2FDN_SG2G [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws (Float -> OvertonesO)
-> (Float, Float) -> Int -> [Char] -> [Char] -> IO ()
h [Char]
ys = do
  n <- [Char] -> IO Int
duration1000 [Char]
file
  vecA <- freqsFromFile file n
  let vecB = Int -> Int -> Vector Float -> Vector Float
liftInEnkuV Int
m Int
ku (Vector Float -> Vector Float)
-> (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Vector Float)
-> (Vector Int -> Vector Int) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Vector Int -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
11440::Int)) (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> a -> b
$ Vector Int
vecA
      zeroN = Vector Float -> Int
forall a. Vector a -> Int
numVZeroesPre Vector Float
vecB
      v2    = Int -> [Char] -> Float -> Vector Float
str2DurationsDef Int
n [Char]
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO)
-> (Float, Float) -> Int -> [Char] -> [Char] -> IO ()
h Float -> OvertonesO
f (Float
x, (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v2)))) Int
j [Char]
wws [Char]
ys
        [Char] -> [Char] -> IO ()
renameFile ([Char]
"result." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
"flac" else [Char]
"wav") ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"result0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
          if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
".flac" else [Char]
".wav") vecB
  endFromResult2G ys  

-- | Similar to 'overSoXSynthGen2FDN', but instead of 'overSoXSynth2FDN' uses 'overSoXSynth2FDN_S' function. 
overSoXSynthGen2FDN_S :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> IO ()
overSoXSynthGen2FDN_S :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynthGen2FDN_S [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN_S

-- | Generalized variant of the 'overSoXSynth2FDN_Sf' with a possibility to adjust volume using 'adjust_dbVol'. 'V.Vector' 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 -> V.Vector Float -> IO ()
overSoXSynth2FDN_Sf1G :: (Float -> OvertonesO)
-> (Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN_Sf1G Float -> OvertonesO
f (Float
x, Float
y) = (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN_Sf31G Float -> OvertonesO
f (Float
x, Float
y, Float
0.001)

-- | 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN_Sf2G :: (Float -> OvertonesO)
-> (Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_Sf2G Float -> OvertonesO
f (Float
x, Float
y) = (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_Sf32G Float -> OvertonesO
f (Float
x, Float
y, Float
0.001)

-- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf' 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_Sf :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> String -> String -> IO ()
overSoXSynthGen2FDN_Sf :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynthGen2FDN_Sf [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y [Char]
zs [Char]
wws = do
  n <- [Char] -> IO Int
duration1000 [Char]
file
  vecA <- freqsFromFile file n
  let vecB = Int -> Int -> Vector Float -> Vector Float
liftInEnkuV Int
m Int
ku (Vector Float -> Vector Float)
-> (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Vector Float)
-> (Vector Int -> Vector Int) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Vector Int -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
11440::Int)) (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> a -> b
$ Vector Int
vecA
      zeroN = Vector Float -> Int
forall a. Vector a -> Int
numVZeroesPre Vector Float
vecB
      v2    = Int -> [Char] -> Float -> Vector Float
str2DurationsDef Int
n [Char]
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO) -> (Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN_Sf Float -> OvertonesO
f (Float
x, (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v2)))) Int
j [Char]
wws
        [Char] -> [Char] -> IO ()
renameFile [Char]
"result.wav" ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"result0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav") vecB
  endFromResult  
   
-- | Generalized variant of the 'overSoXSynth2FDN_Sf3' function with a possibility to adjust volume using 'adjust_dBVol'. 'V.Vector' of 'Float'
-- specifies the needed adjustments in dB.
overSoXSynth2FDN_Sf31G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> V.Vector Float -> IO ()
overSoXSynth2FDN_Sf31G :: (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> Vector Float -> IO ()
overSoXSynth2FDN_Sf31G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j [Char]
zs Vector Float
vdB = (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> [Char]
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_Sf32G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j [Char]
zs Vector Float
vdB []

-- | 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 -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN_Sf35G :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> IO ()
overSoXSynth2FDN_Sf35G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys
 | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let l0 :: Int
l0    = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
    Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Float
-> [Char]
-> IO ()
soundGenF32G ([Float -> Float] -> Vector (Float -> Float)
forall a. [a] -> Vector a
V.fromList [\Float
x -> Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0),\Float
x -> Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
     (Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) (Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)))])
       (Int -> Float -> Vector Float
forall a. Int -> a -> Vector a
V.replicate Int
2 Float
x) ([Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList [Int
1,Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))]) Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Float
vdB [Char]
ys
    if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then IO ()
mixTest else [Char] -> IO ()
mixTest2G [Char]
ys 

-- | Generalized variant of the 'overSoXSynth2FDN_Sf35G' with afterwards 'apply6G' usage.
overSoXSynth2FDN_Sf36G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Intervals -> V.Vector Float -> String -> Float -> IO ()
overSoXSynth2FDN_Sf36G :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN_Sf36G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Int
v5 Vector Float
vdB [Char]
ys Float
vol
 | Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v5 = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let l0 :: Int
l0    = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v5
    Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Float
-> [Char]
-> IO ()
soundGenF32G ([Float -> Float] -> Vector (Float -> Float)
forall a. [a] -> Vector a
V.fromList [\Float
x -> Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0),\Float
x -> Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
     (Int -> Float -> Maybe Float
dNote (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))) (Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)))])
       (Int -> Float -> Vector Float
forall a. Int -> a -> Vector a
V.replicate Int
2 Float
x) ([Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList [Int
1,Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
v5 (Int -> Int
forall a. Num a => a -> a
abs (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l0))]) Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Float
vdB [Char]
ys
    if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then IO ()
mixTest else [Char] -> IO ()
mixTest2G [Char]
ys 
    if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
y Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Float -> [Char] -> IO ()
apply6Gf Float
vol ([Char]
"result." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
"flac" else [Char]
"wav") else [Char] -> IO ()
putStr [Char]
""

-- | 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 -> V.Vector Float -> String -> String -> IO ()
overSoXSynth2FDN_Sf36GS :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> [Char]
-> Vector Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynth2FDN_Sf36GS Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Int
v5 [Char]
xs Vector Float
vdB [Char]
ys [Char]
xxs
 | Vector [Char] -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Vector [Char] -> Bool)
-> ([Char] -> Vector [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Vector [Char]
convertToProperUkrainian ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
xxs = [Char] -> IO ()
putStrLn [Char]
"You provided no information to obtain volume adjustment! "
 | Bool
otherwise = (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Int
-> Vector Float
-> [Char]
-> Float
-> IO ()
overSoXSynth2FDN_Sf36G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j (Vector Int -> [Char] -> Vector Int
intervalsFromStringG Vector Int
v5 [Char]
xs) Vector Float
vdB [Char]
ys ([Char] -> Float
str2Vol1 [Char]
xxs)

-- | 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.
soundGenF3 :: V.Vector (Float -> Float) -> V.Vector Float -> V.Vector Int -> (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> IO ()
soundGenF3 :: Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> IO ()
soundGenF3 Vector (Float -> Float)
vf Vector Float
vd Vector Int
vi Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j = Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Float
-> [Char]
-> IO ()
soundGenF32G Vector (Float -> Float)
vf Vector Float
vd Vector Int
vi Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Float
forall a. Vector a
V.empty []

-- | Generalized variant of the 'soundGenF3' with volume adjustment in dB given by the second @Vector Float@ for the overtones.
soundGenF31G :: V.Vector (Float -> Float) -> V.Vector Float -> V.Vector Int -> (Float -> OvertonesO) -> (Float, Float, Float) -> Int ->
  V.Vector Float -> IO ()
soundGenF31G :: Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Float
-> IO ()
soundGenF31G Vector (Float -> Float)
vf Vector Float
vd Vector Int
vi Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Float
vdB = Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Float
-> [Char]
-> IO ()
soundGenF32G Vector (Float -> Float)
vf Vector Float
vd Vector Int
vi Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Float
vdB [] 

-- | Similar to 'overSoXSynthGen2FDN_S', but instead of 'overSoXSynth2FDN_S' uses 'overSoXSynth2FDN_Sf3' function. 
overSoXSynthGen2FDN_Sf3 :: FilePath -> Int -> Int -> (Float -> OvertonesO) -> Float -> Float -> String -> String -> IO ()
overSoXSynthGen2FDN_Sf3 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> Float
-> [Char]
-> [Char]
-> IO ()
overSoXSynthGen2FDN_Sf3 [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y Float
t0 [Char]
zs [Char]
wws = [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_Sf3G [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y Float
t0 [Char]
zs [Char]
wws (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> IO ()
overSoXSynth2FDN_Sf3

-- | 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float, Float) -> Int -> [Char] -> IO ())
-> IO ()
overSoXSynthGen2FDN_Sf3G [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y Float
t0 [Char]
zs [Char]
wws (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> IO ()
h = do
  n <- [Char] -> IO Int
duration1000 [Char]
file
  vecA <- freqsFromFile file n
  let vecB = Int -> Int -> Vector Float -> Vector Float
liftInEnkuV Int
m Int
ku (Vector Float -> Vector Float)
-> (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Vector Float)
-> (Vector Int -> Vector Int) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Vector Int -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
11440::Int)) (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> a -> b
$ Vector Int
vecA
      zeroN = Vector Float -> Int
forall a. Vector a -> Int
numVZeroesPre Vector Float
vecB
      v2    = Int -> [Char] -> Float -> Vector Float
str2DurationsDef Int
n [Char]
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> IO ()
h Float -> OvertonesO
f (Float
x, (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v2))), Float
t0) Int
j [Char]
wws
        [Char] -> [Char] -> IO ()
renameFile [Char]
"result.wav" ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"result0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav") 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 :: [Char]
-> Int
-> Int
-> (Float -> OvertonesO)
-> Float
-> Float
-> [Char]
-> [Char]
-> ((Float -> OvertonesO)
    -> (Float, Float, Float) -> Int -> [Char] -> [Char] -> IO ())
-> [Char]
-> IO ()
overSoXSynthGen2FDN_Sf3G2G [Char]
file Int
m Int
ku Float -> OvertonesO
f Float
y Float
t0 [Char]
zs [Char]
wws (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> [Char] -> IO ()
h [Char]
ys = do
  n <- [Char] -> IO Int
duration1000 [Char]
file
  vecA <- freqsFromFile file n
  let vecB = Int -> Int -> Vector Float -> Vector Float
liftInEnkuV Int
m Int
ku (Vector Float -> Vector Float)
-> (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Vector Float)
-> (Vector Int -> Vector Int) -> Vector Int -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Vector Int -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
11440::Int)) (Vector Int -> Vector Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> a -> b
$ Vector Int
vecA
      zeroN = Vector Float -> Int
forall a. Vector a -> Int
numVZeroesPre Vector Float
vecB
      v2    = Int -> [Char] -> Float -> Vector Float
str2DurationsDef Int
n [Char]
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> [Char] -> [Char] -> IO ()
h Float -> OvertonesO
f (Float
x, (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v2))), Float
t0) Int
j [Char]
wws [Char]
ys
        [Char] -> [Char] -> IO ()
renameFile ([Char]
"result." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
"flac" else [Char]
"wav") ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"result0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f"
          then [Char]
".flac" else [Char]
".wav") vecB
  endFromResult2G ys