-- |
-- Module      :  DobutokO.Sound.DIS5G6G
-- 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.

{-# OPTIONS_GHC -threaded #-}

module DobutokO.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 qualified Data.Vector as V
import System.Process
import EndOfExe2
import Aftovolio.Ukrainian.Melodics (convertToProperUkrainianI8)
import MMSyn7l
import DobutokO.Sound.IntermediateF
import DobutokO.Sound.Functional.Params
import DobutokO.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 -> Vector String -> Intervals
vStrToVIntG Intervals
v (Vector String -> Intervals)
-> (String -> Vector String) -> String -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Vector String
convertToProperUkrainian

-- | The default way to get 'Intervals' from a converted Ukrainian text.
vStrToVInt :: V.Vector String -> Intervals
vStrToVInt :: Vector String -> Intervals
vStrToVInt = (String -> Int) -> Vector String -> Intervals
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Intervals -> String -> Int
strToIntG Intervals
defInt)

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

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

-- | Arithmetic average for the 'V.Vector' is used as a weight for a duration. 
doublesAveragedA :: V.Vector Float -> Float -> V.Vector Float
doublesAveragedA :: Vector Float -> Float -> Vector Float
doublesAveragedA Vector Float
v4 Float
y3 
  | Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v4 Bool -> Bool -> Bool
|| Float
y3 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Vector Float
forall a. Vector a
V.empty
  | Bool
otherwise = let aver :: Float
aver = Vector Float -> Float
forall a. Num a => Vector a -> a
V.sum Vector Float
v4 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v4) in if Float
aver Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Vector Float -> Float -> Vector Float
doublesAveragedA ((Float -> Bool) -> Vector Float -> Vector Float
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0) Vector Float
v4) Float
y3 
      else (Float -> Float) -> Vector Float -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Float
t4 -> Float
t4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y3 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
aver) Vector Float
v4

-- | Geometric average for the 'V.Vector' is used as a weight for a strength. 
doublesAveragedG :: V.Vector Float -> Float -> V.Vector Float
doublesAveragedG :: Vector Float -> Float -> Vector Float
doublesAveragedG Vector Float
v4 Float
y3 
  | Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v4 Bool -> Bool -> Bool
|| Float
y3 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Vector Float
forall a. Vector a
V.empty
  | Bool
otherwise = let aver :: Float
aver = Vector Float -> Float
forall a. Num a => Vector a -> a
V.product Vector Float
v4 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v4))) in if Float
aver Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Vector Float -> Float -> Vector Float
doublesAveragedG ((Float -> Bool) -> Vector Float -> Vector Float
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0) Vector Float
v4) Float
y3 
      else (Float -> Float) -> Vector Float -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Float
t4 -> Float
t4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y3 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
aver) Vector Float
v4      

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

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

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

-- | Auxiliar function to make all vectors in a 'V.Vector' equal by length (the minimum one).
equalize2Vec :: V.Vector (V.Vector a) -> V.Vector (V.Vector a)
equalize2Vec :: forall a. Vector (Vector a) -> Vector (Vector a)
equalize2Vec Vector (Vector a)
v = let min :: Int
min = Intervals -> Int
forall a. Ord a => Vector a -> a
V.minimum (Intervals -> Int)
-> (Vector (Vector a) -> Intervals) -> Vector (Vector a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Int) -> Vector (Vector a) -> Intervals
forall a b. (a -> b) -> Vector a -> Vector b
V.map Vector a -> Int
forall a. Vector a -> Int
V.length (Vector (Vector a) -> Int) -> Vector (Vector a) -> Int
forall a b. (a -> b) -> a -> b
$ Vector (Vector a)
v in (Vector a -> Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
0 Int
min) Vector (Vector a)
v

-- | A full conversion to the 'Durations' from a Ukrainian text.
str2Durations :: String -> Float -> Durations
str2Durations :: String -> Float -> Vector Float
str2Durations String
xs Float
y 
 | 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 Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs) = Vector Float -> Float -> Vector Float
durationsAver ((String -> Float) -> Vector String -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map String -> Float
str2Durat1 (Vector String -> Vector Float)
-> (String -> Vector String) -> String -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Vector String
convertToProperUkrainian (String -> Vector Float) -> String -> Vector Float
forall a b. (a -> b) -> a -> b
$ String
xs) Float
y
 | Bool
otherwise = Vector Float
forall a. Vector a
V.empty

-- | A conversion to the 'Float' that is used inside 'str2Durations'.
str2Durat1 :: String -> Float
str2Durat1 :: String -> Float
str2Durat1 = Float -> [(String, Float)] -> String -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' (-Float
0.153016) [(String
"-", (-Float
0.101995)), (String
"0", (-Float
0.051020)), (String
"1", (-Float
0.153016)), (String
"а", Float
0.138231), (String
"б", Float
0.057143), 
  (String
"в", Float
0.082268), (String
"г", Float
0.076825), (String
"д", Float
0.072063), (String
"дж", Float
0.048934), (String
"дз", Float
0.055601), (String
"е", Float
0.093605), (String
"ж", Float
0.070658), (String
"з", Float
0.056054), 
    (String
"и", Float
0.099955), (String
"й", Float
0.057143), (String
"к", Float
0.045351), (String
"л", Float
0.064036), (String
"м", Float
0.077370), (String
"н", Float
0.074240), (String
"о", Float
0.116463), (String
"п", Float
0.134830), 
      (String
"р", Float
0.049206), (String
"с", Float
0.074603), (String
"сь", Float
0.074558), (String
"т", Float
0.110658), (String
"у", Float
0.109070), (String
"ф", Float
0.062268), (String
"х", Float
0.077188), (String
"ц", Float
0.053061), 
        (String
"ць", Float
0.089342), (String
"ч", Float
0.057596), (String
"ш", Float
0.066077), (String
"ь", Float
0.020227), (String
"і", Float
0.094150), (String
"ґ", Float
0.062948)]

-- | A full conversion to the 'Strengths' from a Ukrainian text.
str2Volume :: String -> Strengths
str2Volume :: String -> Vector Float
str2Volume = (String -> Float) -> Vector String -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Float -> [(String, Float)] -> String -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.0 [(String
"а", Float
0.890533), (String
"б", Float
0.211334), (String
"в", (-Float
0.630859)), (String
"г", (-Float
0.757599)), (String
"д", Float
0.884613), (String
"дж", Float
0.768127), 
  (String
"дз", (-Float
0.731262)), (String
"е", (-Float
0.742523)), (String
"ж", (-Float
0.588959)), (String
"з", (-Float
0.528870)), (String
"и", Float
0.770935), (String
"й", (-Float
0.708008)), (String
"к", (-Float
0.443085)), 
    (String
"л", Float
0.572632), (String
"м", (-Float
0.782349)), (String
"н", (-Float
0.797607)), (String
"о", (-Float
0.579559)), (String
"п", Float
0.124908), (String
"р", Float
0.647369), (String
"с", Float
0.155640), (String
"сь", (-Float
0.207764)), 
      (String
"т", -Float
0.304443), (String
"у", Float
0.718262), (String
"ф", (-Float
0.374359)), (String
"х", (-Float
0.251160)), (String
"ц", (-Float
0.392365)), (String
"ць", Float
0.381348), (String
"ч", (-Float
0.189240)), 
        (String
"ш", Float
0.251221), (String
"ь", Float
0.495483), (String
"і", (-Float
0.682709)), (String
"ґ", Float
0.557098)]) (Vector String -> Vector Float)
-> (String -> Vector String) -> String -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Vector String
convertToProperUkrainian

-- | A conversion to the 'Float' that is used inside 'str2Volume'.
str2Vol1 :: String -> Float
str2Vol1 :: String -> Float
str2Vol1 = Float -> [(String, Float)] -> String -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.0 [(String
"а", Float
0.890533), (String
"б", Float
0.211334), (String
"в", (-Float
0.630859)), (String
"г", (-Float
0.757599)), (String
"д", Float
0.884613), (String
"дж", Float
0.768127), 
  (String
"дз", (-Float
0.731262)), (String
"е", (-Float
0.742523)), (String
"ж", (-Float
0.588959)), (String
"з", (-Float
0.528870)), (String
"и", Float
0.770935), (String
"й", (-Float
0.708008)), (String
"к", (-Float
0.443085)), 
    (String
"л", Float
0.572632), (String
"м", (-Float
0.782349)), (String
"н", (-Float
0.797607)), (String
"о", (-Float
0.579559)), (String
"п", Float
0.124908), (String
"р", Float
0.647369), (String
"с", Float
0.155640), (String
"сь", (-Float
0.207764)), 
      (String
"т", -Float
0.304443), (String
"у", Float
0.718262), (String
"ф", (-Float
0.374359)), (String
"х", (-Float
0.251160)), (String
"ц", (-Float
0.392365)), (String
"ць", Float
0.381348), (String
"ч", (-Float
0.189240)), 
        (String
"ш", Float
0.251221), (String
"ь", Float
0.495483), (String
"і", (-Float
0.682709)), (String
"ґ", Float
0.557098)] (String -> Float) -> (String -> String) -> String -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector String -> String
forall a. Vector a -> a
V.unsafeHead (Vector String -> String)
-> (String -> Vector String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Vector String
convertToProperUkrainian

-- | 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
  _ <- 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 a. [a] -> 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
""
  putStr ""

-- | After producing sounds as WAV or FLAC files you can apply to them volume adjustments using 'Strengths'. The first 'String' is used accordingly to 
-- 'soxBasicParams' and the second one -- as a prefix of the filenames for the files that the function is applied to. The files must not be silent ones. 
-- Otherwise, it leads to likely noise sounding or errors.
apply6G :: Strengths -> String -> String -> IO ()
apply6G :: Vector Float -> String -> String -> IO ()
apply6G Vector Float
v6 String
ys String
zs 
 | Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v6 = String -> IO ()
putStrLn String
"Nothing changed, because the vector of volume adjustments is empty! "
 | Bool
otherwise = do
     dir0v <- String -> String -> IO (Vector String)
listVDirectory3G String
ys String
zs  
     V.imapM_ (\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) (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v6 (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v6)) 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 silent ones. Otherwise, it leads to likely noise sounding or errors.
apply6GS :: String -> String -> String -> IO ()
apply6GS :: String -> String -> String -> IO ()
apply6GS String
xs = Vector Float -> String -> String -> IO ()
apply6G (String -> Vector 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 :: Vector Float -> String -> String -> Float -> IO ()
apply6G2 Vector Float
v6 String
ys String
zs Float
limV
 | Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v6 = String -> IO ()
putStrLn String
"Nothing changed, because the vector of volume adjustments is empty! "
 | Bool
otherwise = do
     dir0v <- String -> String -> IO (Vector String)
listVDirectory3G String
ys String
zs  
     V.imapM_ (\Int
i String
file -> String -> Float -> Float -> IO ()
apply6GSilentFile String
file Float
limV (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v6 (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v6))) 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 = Vector Float -> String -> String -> Float -> IO ()
apply6G2 (String -> Vector Float
str2Volume String
xs)