{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE BangPatterns #-}
module Composition.Sound.DIS5G6G (
syllableStr
, intervalsFromString
, vStrToVInt
, strToInt
, durationsAver
, str2Durat1
, str2Durations
, str2Vol1
, str2Volume
, doublesAveragedA
, doublesAveragedG
, equalize2Vec
, intervalsFromStringG
, silentSound2G
, strengthsAver
, strengthsDbAver
, apply6G
, apply6G2
, apply6GS
, apply6GS2
) where
import CaseBi.Arr (getBFstLSorted')
import Numeric
import Data.Maybe (fromJust)
import GHC.Arr
import qualified Data.Foldable as F
import System.Process
import EndOfExe
import Melodics.ByteString.Ukrainian.Arr (convertToProperUkrainianS)
import Languages.Phonetic.Ukrainian.Syllable.Arr hiding (str2Durat1)
import MMSyn7l
import Composition.Sound.IntermediateF
import Composition.Sound.Functional.Params
import Composition.Sound.Decibel
intervalsFromStringG :: Intervals -> String -> Intervals
intervalsFromStringG :: Intervals -> String -> Intervals
intervalsFromStringG Intervals
v = Intervals -> String -> Intervals
vStrToVIntG Intervals
v (String -> Intervals) -> (String -> String) -> String -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
convertToProperUkrainianS
vStrToVInt :: String -> Intervals
vStrToVInt :: String -> 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) -> (String -> [Int]) -> String -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Intervals -> Char -> Int
strToIntG Intervals
defInt)
strToInt :: Char -> Int
strToInt :: Char -> Int
strToInt = Intervals -> Char -> Int
strToIntG Intervals
defInt
{-# INLINE strToInt #-}
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
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
durationsAver :: Durations -> Float -> Durations
durationsAver :: Array Int Float -> Float -> Array Int Float
durationsAver = Array Int Float -> Float -> Array Int Float
doublesAveragedA
strengthsAver :: Strengths -> Float -> Strengths
strengthsAver :: Array Int Float -> Float -> Array Int Float
strengthsAver = Array Int Float -> Float -> Array Int Float
doublesAveragedG
strengthsDbAver :: StrengthsDb -> Float -> StrengthsDb
strengthsDbAver :: Array Int Float -> Float -> Array Int Float
strengthsDbAver = Array Int Float -> Float -> Array Int Float
doublesAveragedG
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
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
. (Char -> Float) -> String -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Float
str2Durat1 (String -> [Float]) -> (String -> String) -> String -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String
convertToProperUkrainianS (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. "
str2Durat1 :: Char -> Float
str2Durat1 :: Char -> Float
str2Durat1 = Float -> [(Char, Float)] -> Char -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' (-Float
0.153016) [(Char
'-', (-Float
0.101995)), (Char
'0', (-Float
0.051020)), (Char
'1', (-Float
0.153016)), (Char
'a', Float
0.138231), (Char
'b', Float
0.057143),
(Char
'v', Float
0.082268), (Char
'h', Float
0.076825), (Char
'd', Float
0.072063), (Char
'j', Float
0.048934), (Char
'A', Float
0.055601), (Char
'e', Float
0.093605), (Char
'B', Float
0.070658), (Char
'z', Float
0.056054),
(Char
'y', Float
0.099955), (Char
'C', Float
0.057143), (Char
'k', Float
0.045351), (Char
'l', Float
0.064036), (Char
'm', Float
0.077370), (Char
'n', Float
0.074240), (Char
'o', Float
0.116463), (Char
'p', Float
0.134830),
(Char
'r', Float
0.049206), (Char
's', Float
0.074603), (Char
'D', Float
0.074558), (Char
't', Float
0.110658), (Char
'u', Float
0.109070), (Char
'f', Float
0.062268), (Char
'x', Float
0.077188), (Char
'c', Float
0.053061),
(Char
'w', Float
0.089342), (Char
'E', Float
0.057596), (Char
'F', Float
0.066077), (Char
'q', Float
0.020227), (Char
'i', Float
0.094150), (Char
'g', Float
0.062948)]
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
. (Char -> Float) -> String -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> [(Char, Float)] -> Char -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.0 [(Char
'a', Float
0.890533), (Char
'b', Float
0.211334), (Char
'v', (-Float
0.630859)), (Char
'h', (-Float
0.757599)), (Char
'd', Float
0.884613), (Char
'j', Float
0.768127),
(Char
'A', (-Float
0.731262)), (Char
'e', (-Float
0.742523)), (Char
'B', (-Float
0.588959)), (Char
'z', (-Float
0.528870)), (Char
'y', Float
0.770935), (Char
'C', (-Float
0.708008)), (Char
'k', (-Float
0.443085)),
(Char
'l', Float
0.572632), (Char
'm', (-Float
0.782349)), (Char
'n', (-Float
0.797607)), (Char
'o', (-Float
0.579559)), (Char
'p', Float
0.124908), (Char
'r', Float
0.647369), (Char
's', Float
0.155640), (Char
'D', (-Float
0.207764)),
(Char
't', -Float
0.304443), (Char
'u', Float
0.718262), (Char
'f', (-Float
0.374359)), (Char
'x', (-Float
0.251160)), (Char
'c', (-Float
0.392365)), (Char
'w', Float
0.381348), (Char
'E', (-Float
0.189240)),
(Char
'F', Float
0.251221), (Char
'q', Float
0.495483), (Char
'i', (-Float
0.682709)), (Char
'g', Float
0.557098)]) (String -> [Float]) -> (String -> String) -> String -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
convertToProperUkrainianS
str2Vol1 :: String -> Float
str2Vol1 :: String -> Float
str2Vol1 = Float -> [(Char, Float)] -> Char -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.0 [(Char
'a', Float
0.890533), (Char
'b', Float
0.211334), (Char
'v', (-Float
0.630859)), (Char
'h', (-Float
0.757599)), (Char
'd', Float
0.884613), (Char
'j', Float
0.768127),
(Char
'A', (-Float
0.731262)), (Char
'e', (-Float
0.742523)), (Char
'B', (-Float
0.588959)), (Char
'z', (-Float
0.528870)), (Char
'y', Float
0.770935), (Char
'C', (-Float
0.708008)), (Char
'k', (-Float
0.443085)),
(Char
'l', Float
0.572632), (Char
'm', (-Float
0.782349)), (Char
'n', (-Float
0.797607)), (Char
'o', (-Float
0.579559)), (Char
'p', Float
0.124908), (Char
'r', Float
0.647369), (Char
's', Float
0.155640), (Char
'D', (-Float
0.207764)),
(Char
't', -Float
0.304443), (Char
'u', Float
0.718262), (Char
'f', (-Float
0.374359)), (Char
'x', (-Float
0.251160)), (Char
'c', (-Float
0.392365)), (Char
'w', Float
0.381348), (Char
'E', (-Float
0.189240)),
(Char
'F', Float
0.251221), (Char
'q', Float
0.495483), (Char
'i', (-Float
0.682709)), (Char
'g', Float
0.557098)] (Char -> Float) -> (String -> Char) -> String -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head (String -> Char) -> (String -> String) -> String -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
convertToProperUkrainianS
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 -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
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
""
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 -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
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
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)
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
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)