-- |
-- 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.ByteString.Ukrainian.Arr (convertToProperUkrainianS)
import Languages.Phonetic.Ukrainian.Syllable.Arr hiding (str2Durat1)
import MMSyn7l
import Composition.Sound.IntermediateF
import Composition.Sound.Functional.Params
import Composition.Sound.Decibel

-- | Generatlized version of the 'intervalsFromString' with a possibility to specify your own 'Intervals'.
intervalsFromStringG :: Intervals -> String -> Intervals
intervalsFromStringG :: 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

-- | The default way to get 'Intervals' from a converted Ukrainian text.
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)

-- | The default way to get number of semi-tones between notes in a single element of 'Intervals'.
strToInt :: Char -> Int
strToInt :: Char -> Int
strToInt = Intervals -> Char -> 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
. (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. "

-- | A conversion to the 'Float' that is used inside 'str2Durations'.
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)]

-- | 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
. (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

-- | A conversion to the 'Float' that is used inside 'str2Volume'.
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

-- | 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 -> 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
""

-- | 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 -> 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

-- | 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)