-- |
-- Module      :  Composition.Sound.DIS5G6G
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music from a file (or its part) and a Ukrainian text. 
-- It can also generate a timbre for the notes. Uses SoX inside.

{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE BangPatterns #-}

module Composition.Sound.DIS5G6G (
  -- ** Auxiliary functions
  syllableStr 
  -- *** Working with Intervals, Durations, Strengths and StrengthDb
  , intervalsFromString 
  , vStrToVInt 
  , strToInt
  , durationsAver
  , str2Durat1
  , str2Durations
  , str2Vol1
  , str2Volume
  , doublesAveragedA
  , doublesAveragedG
  , equalize2Vec
  , intervalsFromStringG
  , silentSound2G
  , strengthsAver
  , strengthsDbAver
  -- * New generalized 6G functions that works with Strengths
  , apply6G
  , apply6G2
  , apply6GS
  , apply6GS2
) where

import CaseBi.Arr (getBFstLSorted')
import Numeric
import Data.Maybe (fromJust)
import GHC.Arr
import qualified Data.Foldable as F
import System.Process
import EndOfExe
import Melodics.Ukrainian.ArrInt8 (Sound8,FlowSound,convertToProperUkrainianI8)
import Languages.Phonetic.Ukrainian.Syllable.ArrInt8 hiding (str2Durat1)
import MMSyn7l
import Composition.Sound.IntermediateF
import Composition.Sound.Functional.Params
import Composition.Sound.Decibel

-- | Generatlized version of the 'intervalsFromString' with a possibility to specify your own 'Intervals'.
intervalsFromStringG :: Intervals -> String -> Intervals
intervalsFromStringG :: Intervals -> String -> Intervals
intervalsFromStringG Intervals
v = Intervals -> FlowSound -> Intervals
vStrToVIntG Intervals
v (FlowSound -> Intervals)
-> (String -> FlowSound) -> String -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FlowSound
convertToProperUkrainianI8

-- | The default way to get 'Intervals' from a converted Ukrainian text.
vStrToVInt :: FlowSound -> Intervals
vStrToVInt :: FlowSound -> Intervals
vStrToVInt = (\[Int]
rs -> (Int, Int) -> [Int] -> Intervals
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Int]
rs) ([Int] -> Intervals)
-> (FlowSound -> [Int]) -> FlowSound -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sound8 -> Int) -> FlowSound -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Intervals -> Sound8 -> Int
strToIntG Intervals
defInt)

-- | The default way to get number of semi-tones between notes in a single element of 'Intervals'.
strToInt :: Sound8 -> Int
strToInt :: Sound8 -> Int
strToInt = Intervals -> Sound8 -> Int
strToIntG Intervals
defInt
{-# INLINE strToInt #-}

---------------------------------------------------------------------------------------------------------------------

-- | Arithmetic average for the 'Array' 'Int' is used as a weight for a duration. 
doublesAveragedA :: Array Int Float -> Float -> Array Int Float
doublesAveragedA :: Array Int Float -> Float -> Array Int Float
doublesAveragedA Array Int Float
v4 Float
y3 
  | Array Int Float -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null Array Int Float
v4 Bool -> Bool -> Bool
|| Float
y3 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 Bool -> Bool -> Bool
|| Array Int Float -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Array Int Float
v4 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = String -> Array Int Float
forall a. HasCallStack => String -> a
error String
"Composition.Sound.DIS5G6G.doublesAveragedA: Not defined for such arguments. "
  | Bool
otherwise = let !aver :: Float
aver = Array Int Float -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Array Int Float
v4 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array Int Float -> Int
forall i e. Array i e -> Int
numElements Array Int Float
v4) in (Float -> Float) -> Array Int Float -> Array Int Float
forall a b i. (a -> b) -> Array i a -> Array i b
amap (Float -> Float -> Float
forall a. Num a => a -> a -> a
*(Float
y3 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
aver)) Array Int Float
v4

-- | Geometric average for the 'Array' 'Int' is used as a weight for a strength. 
doublesAveragedG :: Array Int Float -> Float -> Array Int Float
doublesAveragedG :: Array Int Float -> Float -> Array Int Float
doublesAveragedG Array Int Float
v4 Float
y3 
  | Array Int Float -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null Array Int Float
v4 Bool -> Bool -> Bool
|| Float
y3 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 Bool -> Bool -> Bool
|| (Float -> Bool) -> Array Int Float -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0) Array Int Float
v4 = String -> Array Int Float
forall a. HasCallStack => String -> a
error String
"Composition.Sound.DIS5G6G.doublesAveragedG: Not defined for such arguments. "
  | Bool
otherwise = let !aver :: Float
aver = Array Int Float -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product Array Int Float
v4 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array Int Float -> Int
forall i e. Array i e -> Int
numElements Array Int Float
v4))) in (Float -> Float) -> Array Int Float -> Array Int Float
forall a b i. (a -> b) -> Array i a -> Array i b
amap (Float -> Float -> Float
forall a. Num a => a -> a -> a
*(Float
y3 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
aver)) Array Int Float
v4      

-- | 'Durations' accounting the desired average duration.
durationsAver :: Durations -> Float -> Durations
durationsAver :: Array Int Float -> Float -> Array Int Float
durationsAver = Array Int Float -> Float -> Array Int Float
doublesAveragedA

-- | 'Strengths' accounting the desired average strength.
strengthsAver :: Strengths -> Float -> Strengths
strengthsAver :: Array Int Float -> Float -> Array Int Float
strengthsAver = Array Int Float -> Float -> Array Int Float
doublesAveragedG

-- | 'StrengthsDb' accounting the desired average strength in dB.
strengthsDbAver :: StrengthsDb -> Float -> StrengthsDb
strengthsDbAver :: Array Int Float -> Float -> Array Int Float
strengthsDbAver = Array Int Float -> Float -> Array Int Float
doublesAveragedG

-- | Auxiliary function to make all lists in an 'Array' 'Int' equal by length (the minimum one).
equalize2Vec :: Array Int [a] -> Array Int [a]
equalize2Vec :: Array Int [a] -> Array Int [a]
equalize2Vec Array Int [a]
v = let min :: Int
min = Intervals -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Intervals -> Int)
-> (Array Int [a] -> Intervals) -> Array Int [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Int) -> Array Int [a] -> Intervals
forall a b i. (a -> b) -> Array i a -> Array i b
amap [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Array Int [a] -> Int) -> Array Int [a] -> Int
forall a b. (a -> b) -> a -> b
$ Array Int [a]
v in ([a] -> [a]) -> Array Int [a] -> Array Int [a]
forall a b i. (a -> b) -> Array i a -> Array i b
amap (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
min) (Array Int [a] -> Array Int [a]) -> Array Int [a] -> Array Int [a]
forall a b. (a -> b) -> a -> b
$ Array Int [a]
v

-- | A full conversion to the 'Durations' from a Ukrainian text. The 'String' must be not empty Ukrainian text and
-- the 'Float' must be greater than 0.0.
str2Durations :: String -> Float -> Durations
str2Durations :: String -> Float -> Array Int Float
str2Durations String
xs Float
y 
 | Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.0 Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs) = Array Int Float -> Float -> Array Int Float
durationsAver ((\[Float]
rs -> (Int, Int) -> [Float] -> Array Int Float
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Float]
rs) ([Float] -> Array Int Float)
-> (String -> [Float]) -> String -> Array Int Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sound8 -> Float) -> FlowSound -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Sound8 -> Float
str2Durat1 (FlowSound -> [Float])
-> (String -> FlowSound) -> String -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> FlowSound
convertToProperUkrainianI8 (String -> Array Int Float) -> String -> Array Int Float
forall a b. (a -> b) -> a -> b
$ String
xs) Float
y
 | Bool
otherwise = String -> Array Int Float
forall a. HasCallStack => String -> a
error String
"Composition.Sound.DIS5G6G.str2Durations: Not defined for such arguments. "

-- | A conversion to the 'Float' that is used inside 'str2Durations'.
str2Durat1 :: Sound8 -> Float
str2Durat1 :: Sound8 -> Float
str2Durat1 = Float -> [(Sound8, Float)] -> Sound8 -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.051020 [(Sound8
1,Float
0.138231),(Sound8
2,Float
9.3605e-2),(Sound8
3,Float
0.116463),(Sound8
4,Float
0.10907),(Sound8
5,Float
9.9955e-2),(Sound8
6,Float
9.415e-2),(Sound8
7,Float
2.0227e-2),(Sound8
8,Float
5.5601e-2),(Sound8
9,Float
5.5601e-2),(Sound8
10,Float
7.0658e-2),(Sound8
11,Float
7.0658e-2),(Sound8
15,Float
5.7143e-2),(Sound8
16,Float
5.7143e-2),(Sound8
17,Float
7.2063e-2),(Sound8
18,Float
7.2063e-2),(Sound8
19,Float
6.2948e-2),(Sound8
20,Float
6.2948e-2),(Sound8
21,Float
7.6825e-2),(Sound8
22,Float
7.6825e-2),(Sound8
23,Float
4.8934e-2),(Sound8
24,Float
4.8934e-2),(Sound8
25,Float
5.6054e-2),(Sound8
26,Float
5.6054e-2),(Sound8
27,Float
5.7143e-2),(Sound8
28,Float
6.4036e-2),(Sound8
29,Float
6.4036e-2),(Sound8
30,Float
7.737e-2),(Sound8
31,Float
7.737e-2),(Sound8
32,Float
7.424e-2),(Sound8
33,Float
7.424e-2),(Sound8
34,Float
4.9206e-2),(Sound8
35,Float
4.9206e-2),(Sound8
36,Float
8.2268e-2),(Sound8
37,Float
8.2268e-2),(Sound8
38,Float
5.3061e-2),(Sound8
39,Float
5.7596e-2),(Sound8
40,Float
5.7596e-2),(Sound8
41,Float
6.6077e-2),(Sound8
42,Float
6.6077e-2),(Sound8
43,Float
6.2268e-2),(Sound8
44,Float
6.2268e-2),(Sound8
45,Float
4.5351e-2),(Sound8
46,Float
4.5351e-2),(Sound8
47,Float
0.13483),(Sound8
48,Float
0.13483),(Sound8
49,Float
7.4603e-2),(Sound8
50,Float
0.110658),(Sound8
51,Float
0.110658),(Sound8
52,Float
7.7188e-2),(Sound8
53,Float
7.7188e-2),(Sound8
54,Float
7.4558e-2),(Sound8
66,Float
8.9342e-2)]

-- | A full conversion to the 'Strengths' from a Ukrainian text.
str2Volume :: String -> Strengths
str2Volume :: String -> Array Int Float
str2Volume = (\[Float]
rs -> (Int, Int) -> [Float] -> Array Int Float
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Float]
rs) ([Float] -> Array Int Float)
-> (String -> [Float]) -> String -> Array Int Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
 (Sound8 -> Float) -> FlowSound -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> [(Sound8, Float)] -> Sound8 -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.06408817 [(Sound8
1,Float
0.27161466),(Sound8
2,Float
0.27192511),(Sound8
3,Float
0.28539351),(Sound8
4,Float
0.25250039),(Sound8
5,Float
0.2050935),(Sound8
6,Float
0.20026538),(Sound8
7,Float
2.218624e-2),(Sound8
8,Float
7.729654e-2),(Sound8
9,Float
7.729654e-2),(Sound8
10,Float
8.048113e-2),(Sound8
11,Float
8.048113e-2),(Sound8
15,Float
0.10977617),(Sound8
16,Float
0.10977617),(Sound8
17,Float
6.58655e-2),(Sound8
18,Float
6.58655e-2),(Sound8
19,Float
7.751571e-2),(Sound8
20,Float
7.751571e-2),(Sound8
21,Float
5.392745e-2),(Sound8
22,Float
5.392745e-2),(Sound8
23,Float
8.900757e-2),(Sound8
24,Float
8.900757e-2),(Sound8
25,Float
6.099951e-2),(Sound8
26,Float
6.099951e-2),(Sound8
27,Float
8.226452e-2),(Sound8
28,Float
0.11159399),(Sound8
29,Float
0.11159399),(Sound8
30,Float
0.14303837),(Sound8
31,Float
0.14303837),(Sound8
32,Float
5.639178e-2),(Sound8
33,Float
5.639178e-2),(Sound8
34,Float
6.354637e-2),(Sound8
35,Float
6.354637e-2),(Sound8
36,Float
8.404524e-2),(Sound8
37,Float
8.404524e-2),(Sound8
38,Float
5.616409e-2),(Sound8
39,Float
0.12541547),(Sound8
40,Float
0.12541547),(Sound8
41,Float
0.12838476),(Sound8
42,Float
0.12838476),(Sound8
43,Float
0.15776219),(Sound8
44,Float
0.15776219),(Sound8
45,Float
4.91782e-2),(Sound8
46,Float
4.91782e-2),(Sound8
47,Float
9.603085e-2),(Sound8
48,Float
9.603085e-2),(Sound8
49,Float
5.294375e-2),(Sound8
50,Float
5.047358e-2),(Sound8
51,Float
5.047358e-2),(Sound8
52,Float
7.905155e-2),(Sound8
53,Float
7.905155e-2),(Sound8
54,Float
7.512999e-2),(Sound8
66,Float
7.835033e-2)]) (FlowSound -> [Float])
-> (String -> FlowSound) -> String -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FlowSound
convertToProperUkrainianI8

-- | A conversion to the 'Float' that is used inside 'str2Volume'.
str2Vol1 :: String -> Float
str2Vol1 :: String -> Float
str2Vol1 = Float -> [(Sound8, Float)] -> Sound8 -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.06408817 [(Sound8
1,Float
0.27161466),(Sound8
2,Float
0.27192511),(Sound8
3,Float
0.28539351),(Sound8
4,Float
0.25250039),(Sound8
5,Float
0.2050935),(Sound8
6,Float
0.20026538),(Sound8
7,Float
2.218624e-2),(Sound8
8,Float
7.729654e-2),(Sound8
9,Float
7.729654e-2),(Sound8
10,Float
8.048113e-2),(Sound8
11,Float
8.048113e-2),(Sound8
15,Float
0.10977617),(Sound8
16,Float
0.10977617),(Sound8
17,Float
6.58655e-2),(Sound8
18,Float
6.58655e-2),(Sound8
19,Float
7.751571e-2),(Sound8
20,Float
7.751571e-2),(Sound8
21,Float
5.392745e-2),(Sound8
22,Float
5.392745e-2),(Sound8
23,Float
8.900757e-2),(Sound8
24,Float
8.900757e-2),(Sound8
25,Float
6.099951e-2),(Sound8
26,Float
6.099951e-2),(Sound8
27,Float
8.226452e-2),(Sound8
28,Float
0.11159399),(Sound8
29,Float
0.11159399),(Sound8
30,Float
0.14303837),(Sound8
31,Float
0.14303837),(Sound8
32,Float
5.639178e-2),(Sound8
33,Float
5.639178e-2),(Sound8
34,Float
6.354637e-2),(Sound8
35,Float
6.354637e-2),(Sound8
36,Float
8.404524e-2),(Sound8
37,Float
8.404524e-2),(Sound8
38,Float
5.616409e-2),(Sound8
39,Float
0.12541547),(Sound8
40,Float
0.12541547),(Sound8
41,Float
0.12838476),(Sound8
42,Float
0.12838476),(Sound8
43,Float
0.15776219),(Sound8
44,Float
0.15776219),(Sound8
45,Float
4.91782e-2),(Sound8
46,Float
4.91782e-2),(Sound8
47,Float
9.603085e-2),(Sound8
48,Float
9.603085e-2),(Sound8
49,Float
5.294375e-2),(Sound8
50,Float
5.047358e-2),(Sound8
51,Float
5.047358e-2),(Sound8
52,Float
7.905155e-2),(Sound8
53,Float
7.905155e-2),(Sound8
54,Float
7.512999e-2),(Sound8
66,Float
7.835033e-2)]
 (Sound8 -> Float) -> (String -> Sound8) -> String -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> Sound8
forall a. [a] -> a
head (FlowSound -> Sound8) -> (String -> FlowSound) -> String -> Sound8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FlowSound
convertToProperUkrainianI8

-- | For the given non-existing 'FilePath' for a sound file supported by SoX generates a silence of the specified
-- duration and quality (see, 'soxBasicParams').
silentSound2G :: FilePath -> Float -> String -> IO ()
silentSound2G :: String -> Float -> String -> IO ()
silentSound2G String
file Float
y4 String
ys = do
  (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) 
     ((if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys then [String] -> [String]
forall a. a -> a
id else String -> [String] -> [String]
soxBasicParams String
ys) [String
"-r22040",String
"-n",String
file,String
"synth", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Float
y4 String
"",String
"sine",String
"440.0",String
"vol",String
"0"]) String
""
  String -> IO ()
putStr String
""

-- | After producing sounds as WAV or FLAC files you can apply to them volume adjustments using 'Strengths'. The first 'String' is used accordingly to 
-- 'soxBasicParams' and the second one -- as a prefix of the filenames for the files that the function is applied to. The files must not be silent ones. 
-- Otherwise, it leads to likely noise sounding or errors.
apply6G :: Strengths -> String -> String -> IO ()
apply6G :: Array Int Float -> String -> String -> IO ()
apply6G Array Int Float
v6 String
ys String
zs 
 | Array Int Float -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null Array Int Float
v6 = String -> IO ()
putStrLn String
"Composition.Sound.DIS5G6G.apply6G: Nothing has changed, because the array of volume adjustments is empty! "
 | Bool
otherwise = do
     [String]
dir0v <- (Array Int String -> [String])
-> IO (Array Int String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Int String -> [String]
forall i e. Array i e -> [e]
elems (IO (Array Int String) -> IO [String])
-> (String -> IO (Array Int String)) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO (Array Int String)
listVDirectory3G String
ys (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
zs
     let !l6 :: Int
l6 = Array Int Float -> Int
forall i e. Array i e -> Int
numElements Array Int Float
v6
     ((Int, String) -> IO ()) -> [(Int, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
i, String
file) -> String -> [String] -> IO ()
soxE String
file [String
"norm",String
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
v6 (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l6)) String
""]) ([(Int, String)] -> IO ())
-> ([String] -> [(Int, String)]) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
dir0v

-- | Variant of the 'apply6G' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as a first 'String' argument. 
-- It uses 'str2Volume' inside. The files must not be the silent ones. Otherwise, it leads to likely noise sounding or errors.
apply6GS :: String -> String -> String -> IO ()
apply6GS :: String -> String -> String -> IO ()
apply6GS String
xs = Array Int Float -> String -> String -> IO ()
apply6G (String -> Array Int Float
str2Volume String
xs)

-- | Variant of the 'apply6G' function which can be applied also to the silent files. Whether a file is silent is defined using the 'Float' argument 
-- so that if the maximum by absolute value amplitude is less by absolute value than the 'Float' argument then the file is not changed.
apply6G2 :: Strengths -> String -> String -> Float -> IO ()
apply6G2 :: Array Int Float -> String -> String -> Float -> IO ()
apply6G2 Array Int Float
v6 String
ys String
zs Float
limV
 | Array Int Float -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null Array Int Float
v6 = String -> IO ()
putStrLn String
"Composition.Sound.DIS5G6G.apply6G2: Nothing has changed, because the array of volume adjustments is empty! "
 | Bool
otherwise = do
     [String]
dir0v <- (Array Int String -> [String])
-> IO (Array Int String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Int String -> [String]
forall i e. Array i e -> [e]
elems (IO (Array Int String) -> IO [String])
-> (String -> IO (Array Int String)) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO (Array Int String)
listVDirectory3G String
ys (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
zs
     let !l6 :: Int
l6 = Array Int Float -> Int
forall i e. Array i e -> Int
numElements Array Int Float
v6
     ((Int, String) -> IO ()) -> [(Int, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
i, String
file) -> String -> Float -> Float -> IO ()
apply6GSilentFile String
file Float
limV (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
v6 (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l6))) ([(Int, String)] -> IO ())
-> ([String] -> [(Int, String)]) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
dir0v

-- | Variant of the 'apply6G2' where you use as a 'Strengths' parameter that one obtained from a Ukrainian text provided as the first 'String' argument. 
-- It uses 'str2Volume' inside. 
apply6GS2 :: String -> String -> String -> Float -> IO ()
apply6GS2 :: String -> String -> String -> Float -> IO ()
apply6GS2 String
xs = Array Int Float -> String -> String -> Float -> IO ()
apply6G2 (String -> Array Int Float
str2Volume String
xs)