-- |
-- Module      :  DobutokO.Sound.Functional.Params
-- 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. Is more complicated than
-- dobutokO2 and uses its functionality.

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

module DobutokO.Sound.Functional.Params (
  Params (..)
  -- * Type synonyms with different semantics
  , Durations
  , Strengths
  , Intervals
  -- * New generalizations for scales and modes with Params
  , filterInParams
  , sortNoDup
  , toneD
  , toneE
  , liftInParams
  , liftInParamsV
  , lengthP
  , elemP
  , elemCloseP
  , showD
  , isStrParams
  , isListParams
  -- ** Application of the Params
  , overSoXSynthGen2FDN_SG4GPar
  , overSoXSynthGen2FDN_SG6GPar
  , overSoXSynthGen2FDN_SG2GPar
  , overSoXSynthGen2FDN_SfPar
  , overSoXSynthGen2FDN_Sf3GPar
  , overSoXSynthGen2FDN_Sf3G2GPar  
  -- * Creating melody from overtones
  , overMeloPar
  -- * Additional functions
  , str2DurationsDef
  , signsFromString
  , apply6Gf
  , apply6GSilentFile
  , vStrToVIntG
  , strToIntG
  , defInt
  , syllableStr
  , overSoXSynth2FDN_Sf
  , overSoXSynth2FDN_Sf3
  , overSoXSynth2FDN_Sf32G
  , intervalsFromString
  , soundGenF32G
  , helpF0
  , helpF1
  , convertToProperUkrainian
  , newRepresentation
  , doubleVecFromVecOfFloat
) where

import CaseBi.Arr 
import GHC.Arr
import Numeric
import Data.List (sort)
import Data.Maybe (isNothing,fromJust,isJust,fromMaybe)
import qualified Data.Vector as V
import System.Process
import EndOfExe2
import System.Directory
import Aftovolio.Ukrainian.Melodics (convertToProperUkrainianI8)
import Sound.SoXBasics (upperBnd,selMaxAbs)
import MMSyn7l
import GHC.Int (Int8)
import Aftovolio.Ukrainian.Syllable 
import DobutokO.Sound.IntermediateF
import DobutokO.Sound.Functional.Basics

convertToProperUkrainian :: String -> V.Vector String
convertToProperUkrainian :: String -> Vector String
convertToProperUkrainian = [Int8] -> Vector String
newRepresentation ([Int8] -> Vector String)
-> (String -> [Int8]) -> String -> Vector String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int8]
convertToProperUkrainianI8
{-# INLINE convertToProperUkrainian #-}

newRepresentation :: [Int8] -> V.Vector String
newRepresentation :: [Int8] -> Vector String
newRepresentation = [String] -> Vector String
forall a. [a] -> Vector a
V.fromList ([String] -> Vector String)
-> ([Int8] -> [String]) -> [Int8] -> Vector String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> String) -> [Int8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int8 -> String
f
  where f :: Int8 -> String
f = String -> [(Int8, String)] -> Int8 -> String
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' String
"" [(Int8
1,String
"\1072"),(Int8
2,String
"\1077"),(Int8
3,String
"\1086"),(Int8
4,String
"\1091"),(Int8
5,String
"\1080"),(Int8
6,String
"\1110"),(Int8
7,String
"\1100"),(Int8
8,String
"\1076\1079"),(Int8
10,String
"\1078"),(Int8
15,String
"\1073"),(Int8
17,String
"\1076"),(Int8
19,String
"\1075"),(Int8
21,String
"\1169"),(Int8
23,String
"\1076\1078"),(Int8
25,String
"\1079"),(Int8
27,String
"\1081"),(Int8
28,String
"\1083"),(Int8
30,String
"\1084"),(Int8
32,String
"\1085"),(Int8
34,String
"\1088"),(Int8
36,String
"\1074"),(Int8
38,String
"\1094"),(Int8
39,String
"\1095"),(Int8
41,String
"\1096"),(Int8
43,String
"\1092"),(Int8
45,String
"\1082"),(Int8
47,String
"\1087"),(Int8
49,String
"\1089"),(Int8
50,String
"\1090"),(Int8
52,String
"\1093"),(Int8
54,String
"\1089\1100"),(Int8
66,String
"\1094\1100"),(Int8
100,String
"0"),(Int8
101,String
"1")]

-- | Representation of the scales and modes for the notes. Can be extended further, but for a lot of situations the following realization is sufficient. 
-- See, for example, 'filterInParams' and so on. 'String' is (are) used as a general classification name, for some of them there are provided two 
-- 'String' to classify. Lists are used to specify remainders in some meaning. See also, 'liftInParams' and 'toneE' ('toneD') functions, 'elemP' and 
-- 'elemCloseP', 'lengthP' and 'showD'.
data Params = P2 Int Int | P2s Int Int String | P3sf Int Int Int String | P4lsf Int Int Int [Int] String | P32sf Int Int Int String String 
 | P3lf Int Int [Int] deriving (Params -> Params -> Bool
(Params -> Params -> Bool)
-> (Params -> Params -> Bool) -> Eq Params
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Params -> Params -> Bool
== :: Params -> Params -> Bool
$c/= :: Params -> Params -> Bool
/= :: Params -> Params -> Bool
Eq, Eq Params
Eq Params =>
(Params -> Params -> Ordering)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Params)
-> (Params -> Params -> Params)
-> Ord Params
Params -> Params -> Bool
Params -> Params -> Ordering
Params -> Params -> Params
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Params -> Params -> Ordering
compare :: Params -> Params -> Ordering
$c< :: Params -> Params -> Bool
< :: Params -> Params -> Bool
$c<= :: Params -> Params -> Bool
<= :: Params -> Params -> Bool
$c> :: Params -> Params -> Bool
> :: Params -> Params -> Bool
$c>= :: Params -> Params -> Bool
>= :: Params -> Params -> Bool
$cmax :: Params -> Params -> Params
max :: Params -> Params -> Params
$cmin :: Params -> Params -> Params
min :: Params -> Params -> Params
Ord, Int -> Params -> ShowS
[Params] -> ShowS
Params -> String
(Int -> Params -> ShowS)
-> (Params -> String) -> ([Params] -> ShowS) -> Show Params
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Params -> ShowS
showsPrec :: Int -> Params -> ShowS
$cshow :: Params -> String
show :: Params -> String
$cshowList :: [Params] -> ShowS
showList :: [Params] -> ShowS
Show)

-- | Is used to represent a set of durations parameters of the sounds and pauses. The positive value corresponds to the sound 
-- and the negative one -- to the pause.
type Durations = V.Vector Float

-- | Is used to represent a set of volumes in the amplitude scale for SoX \"vol\" effect.
type Strengths = V.Vector Float

-- | Is used to represent a set of intervals for notes (each element is a number of semi-tones between parts of interval). 
-- Positive values corresponds to lower notes and negative to higher ones.
type Intervals = V.Vector Int

-- | Additional function to produce signs from the given 'String' of the Ukrainian text. Ukrainian vowels and voiced consonants gives \"+\" sign (+1), voiceless
-- and sonorous consonants gives \"-\" sign (-1). Voiceless2 gives "0". Other symbols are not taken into account.
signsFromString :: Int -> String -> V.Vector Int
signsFromString :: Int -> String -> Vector Int
signsFromString Int
n1 =
  Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
V.take Int
n1 (Vector Int -> Vector Int)
-> (String -> Vector Int) -> String -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ([Int] -> Vector Int) -> (String -> [Int]) -> String -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Int8]] -> [Int]) -> [[[Int8]]] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int8 -> Int) -> [Int8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int8
x -> if 
      | Int8 -> Bool
isVowel1 Int8
x -> Int
1
      | Int8 -> Bool
isVoicedC1 Int8
x -> Int
1
      | Int8 -> Bool
isVoicelessC1 Int8
x -> (-Int
1)
      | Int8 -> Bool
isSonorous1 Int8
x -> (-Int
1)
      | Bool
otherwise -> Int
0) ([Int8] -> [Int]) -> ([[Int8]] -> [Int8]) -> [[Int8]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int8] -> [Int8]) -> [[Int8]] -> [Int8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Int8] -> [Int8]
representProlonged) ([[[Int8]]] -> [Int]) -> (String -> [[[Int8]]]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
createSyllablesUkrS (String -> [[[Int8]]]) -> ShowS -> String -> [[[Int8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n1) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. HasCallStack => [a] -> [a]
cycle 
 
-- | Generalized version of the 'overSoXSynthGen2FDN_SG4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to 
-- use some tonality. For more information, please, refer to 'filterInParams'.
overSoXSynthGen2FDN_SG4GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> 
  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> IO ()
overSoXSynthGen2FDN_SG4GPar :: String
-> Params
-> (Float -> OvertonesO)
-> Float
-> Vector Float
-> String
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> String -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG4GPar String
file Params
params Float -> OvertonesO
f Float
y Vector Float
v2 String
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
h = do
  n <- String -> IO Int
duration1000 String
file
  vecA <- freqsFromFile file n
  let vecB = Params -> Vector Float -> Vector Float
liftInParamsV Params
params (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 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 -> String -> 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 String
wws
        String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> String
forall a. Show a => a -> String
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav") vecB
  endFromResult  
   
-- | Generalized version of the 'overSoXSynthGen2FDN_SG6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to 
-- use some tonality. For more information, please, refer to 'filterInParams'.
overSoXSynthGen2FDN_SG6GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> 
  ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> Strengths -> Float -> IO ()
overSoXSynthGen2FDN_SG6GPar :: String
-> Params
-> (Float -> OvertonesO)
-> Float
-> Vector Float
-> String
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> String -> IO ())
-> Vector Float
-> Float
-> IO ()
overSoXSynthGen2FDN_SG6GPar String
file Params
params Float -> OvertonesO
f Float
y Vector Float
v2 String
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
h Vector Float
v6 Float
limV
 | Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v6 = String -> IO ()
putStrLn String
"You did not provide a volume adjustments vector! "
 | Bool
otherwise = do
    n <- String -> IO Int
duration1000 String
file
    vecA <- freqsFromFile file n
    let vecB = Params -> Vector Float -> Vector Float
liftInParamsV Params
params (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 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 -> String -> 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 String
wws
          String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> String
forall a. Show a => a -> String
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav"
          String -> Float -> Float -> IO ()
apply6GSilentFile (String
"result0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> String
forall a. Show a => a -> String
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".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        

-- | Generalized version of the 'overSoXSynthGen2FDN_SG2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to 
-- use some tonality. For more information, please, refer to 'filterInParams'.
overSoXSynthGen2FDN_SG2GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> String -> String -> ((Float -> OvertonesO) ->
  (Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO ()
overSoXSynthGen2FDN_SG2GPar :: String
-> Params
-> (Float -> OvertonesO)
-> Float
-> String
-> String
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> String -> String -> IO ())
-> String
-> IO ()
overSoXSynthGen2FDN_SG2GPar String
file Params
params Float -> OvertonesO
f Float
y String
zs String
wws (Float -> OvertonesO)
-> (Float, Float) -> Int -> String -> String -> IO ()
h String
ys = do
  n <- String -> IO Int
duration1000 String
file
  vecA <- freqsFromFile file n
  let vecB = Params -> Vector Float -> Vector Float
liftInParamsV Params
params (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 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 -> String -> Float -> Vector Float
str2DurationsDef Int
n String
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO)
-> (Float, Float) -> Int -> String -> String -> 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 String
wws String
ys
        String -> String -> IO ()
renameFile (String
"result." String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
"flac" else String
"wav") (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> String
forall a. Show a => a -> String
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++
          if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
".flac" else String
".wav") vecB
  endFromResult2G ys    

-- | Generalized version of the 'overSoXSynthGen2FDN_Sf' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to 
-- use some tonality. For more information, please, refer to 'filterInParams'.
overSoXSynthGen2FDN_SfPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> String -> String -> IO ()
overSoXSynthGen2FDN_SfPar :: String
-> Params
-> (Float -> OvertonesO)
-> Float
-> String
-> String
-> IO ()
overSoXSynthGen2FDN_SfPar String
file Params
params Float -> OvertonesO
f Float
y String
zs String
wws = do
  n <- String -> IO Int
duration1000 String
file
  vecA <- freqsFromFile file n
  let vecB = Params -> Vector Float -> Vector Float
liftInParamsV Params
params (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 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 -> String -> Float -> Vector Float
str2DurationsDef Int
n String
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> 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 String
wws
        String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> String
forall a. Show a => a -> String
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav") vecB
  endFromResult    
    
-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to 
-- use some tonality. For more information, please, refer to 'filterInParams'.
overSoXSynthGen2FDN_Sf3GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Float -> String -> String ->
 ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> IO ()) -> IO ()
overSoXSynthGen2FDN_Sf3GPar :: String
-> Params
-> (Float -> OvertonesO)
-> Float
-> Float
-> String
-> String
-> ((Float -> OvertonesO)
    -> (Float, Float, Float) -> Int -> String -> IO ())
-> IO ()
overSoXSynthGen2FDN_Sf3GPar String
file Params
params Float -> OvertonesO
f Float
y Float
t0 String
zs String
wws (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> IO ()
h = do
  n <- String -> IO Int
duration1000 String
file
  vecA <- freqsFromFile file n
  let vecB = Params -> Vector Float -> Vector Float
liftInParamsV Params
params (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 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 -> String -> Float -> Vector Float
str2DurationsDef Int
n String
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> 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 String
wws
        String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> String
forall a. Show a => a -> String
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav") vecB
  endFromResult  

-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to 
-- use some tonality. For more information, please, refer to 'filterInParams'.
overSoXSynthGen2FDN_Sf3G2GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Float -> String -> String ->
 ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO ()
overSoXSynthGen2FDN_Sf3G2GPar :: String
-> Params
-> (Float -> OvertonesO)
-> Float
-> Float
-> String
-> String
-> ((Float -> OvertonesO)
    -> (Float, Float, Float) -> Int -> String -> String -> IO ())
-> String
-> IO ()
overSoXSynthGen2FDN_Sf3G2GPar String
file Params
params Float -> OvertonesO
f Float
y Float
t0 String
zs String
wws (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> String -> IO ()
h String
ys = do
  n <- String -> IO Int
duration1000 String
file
  vecA <- freqsFromFile file n
  let vecB = Params -> Vector Float -> Vector Float
liftInParamsV Params
params (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 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 -> String -> Float -> Vector Float
str2DurationsDef Int
n String
zs Float
y in V.imapM_ (\Int
j Float
x -> do
        (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> String -> 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 String
wws String
ys
        String -> String -> IO ()
renameFile (String
"result." String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f" then String
"flac" else String
"wav") (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> String
forall a. Show a => a -> String
show (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"f"
          then String
".flac" else String
".wav") vecB
  endFromResult2G ys    

-- | A way to get from a 'Params' a corresponding 'V.Vector' of 'Float' (if any) and so to work with them further. May contain some issues 
-- so please, before production usage check thoroughly. 
-- For information there were used the following: 
-- 
-- https://en.wikipedia.org/wiki/Mode_(music)
-- 
-- https://en.wikipedia.org/wiki/Ukrainian_Dorian_scale
-- 
-- https://en.wikipedia.org/wiki/List_of_musical_scales_and_modes
-- 
-- https://en.wikipedia.org/wiki/Octatonic_scale
-- 
-- several other articles in the English Wikipedia 
-- 
-- and in Ukrainian: 	
-- Смаглій Г., Маловик Л. Теорія музики : Підруч. для навч. закл. освіти, культури і мистецтв / Г.А. Смаглій. -- Х. : Вид-во \"Ранок\", 2013. -- 392 с. 
-- ISBN 978-617-09-1294-7
-- 
filterInParams :: Params -> Maybe (V.Vector Float)
filterInParams :: Params -> Maybe (Vector Float)
filterInParams (P3lf Int
n2 Int
nL [Int]
zs) -- generalized sound series, e. g. the chromatic ones etc.
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
n -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) ([Int
nL,Int
107 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n2,Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
zs) = 
    if Vector Float -> Bool
forall a. Vector a -> Bool
V.null (Vector Float -> Bool)
-> (Vector Float -> Vector Float) -> Vector Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) Int
i) (Vector Float -> Bool) -> Vector Float -> Bool
forall a b. (a -> b) -> a -> b
$ 
     (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)
      then Maybe (Vector Float)
forall a. Maybe a
Nothing
      else Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) Int
i) 
        (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
 | Bool
otherwise = Maybe (Vector Float)
forall a. Maybe a
Nothing
filterInParams (P32sf Int
nT Int
n2 Int
nL String
xs String
ys) -- dur and moll in various their modifications
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
n -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) [Int
107 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n2,Int
nT,Int
nL,Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL,Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT,Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12] = 
    case String
xs of 
      String
"dur" -> (Maybe (Vector Float), Array Int (String, Maybe (Vector Float)))
-> String -> Maybe (Vector Float)
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Maybe (Vector Float)
forall a. Maybe a
Nothing,(Int, Int)
-> [(String, Maybe (Vector Float))]
-> Array Int (String, Maybe (Vector Float))
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) ([(String, Maybe (Vector Float))]
 -> Array Int (String, Maybe (Vector Float)))
-> ([Maybe (Vector Float)] -> [(String, Maybe (Vector Float))])
-> [Maybe (Vector Float)]
-> Array Int (String, Maybe (Vector Float))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String]
-> [Maybe (Vector Float)] -> [(String, Maybe (Vector Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"FloatH",String
"H",String
"Full",String
"Full moll",String
"M",String
"N"] ([Maybe (Vector Float)]
 -> Array Int (String, Maybe (Vector Float)))
-> [Maybe (Vector Float)]
-> Array Int (String, Maybe (Vector Float))
forall a b. (a -> b) -> a -> b
$ (Vector Float -> Maybe (Vector Float))
-> [Vector Float] -> [Maybe (Vector Float)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just 
        [(Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
2,Int
3,Int
6,Int
8,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
1,Int
3,Int
5,Int
9,Int
10]) 
          (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> ((Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (((Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
12) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
1,Int
3,Int
5]) 
            (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> ((Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (((Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
12) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
1,Int
6]) 
              (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
1,Int
3,Int
5,Int
9,Int
11]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
                (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
1,Int
3,Int
5,Int
8,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)]) String
ys
      String
"moll" -> (Maybe (Vector Float), Array Int (String, Maybe (Vector Float)))
-> String -> Maybe (Vector Float)
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Maybe (Vector Float)
forall a. Maybe a
Nothing,(Int, Int)
-> [(String, Maybe (Vector Float))]
-> Array Int (String, Maybe (Vector Float))
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) ([(String, Maybe (Vector Float))]
 -> Array Int (String, Maybe (Vector Float)))
-> ([Maybe (Vector Float)] -> [(String, Maybe (Vector Float))])
-> [Maybe (Vector Float)]
-> Array Int (String, Maybe (Vector Float))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String]
-> [Maybe (Vector Float)] -> [(String, Maybe (Vector Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"FloatH1",String
"H",String
"Full",String
"Full dur",String
"M",String
"N"] ([Maybe (Vector Float)]
 -> Array Int (String, Maybe (Vector Float)))
-> [Maybe (Vector Float)]
-> Array Int (String, Maybe (Vector Float))
forall a b. (a -> b) -> a -> b
$ (Vector Float -> Maybe (Vector Float))
-> [Vector Float] -> [Maybe (Vector Float)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just 
        [(Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
1,Int
4,Int
5,Int
9,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
1,Int
4,Int
6,Int
9,Int
10]) 
          (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> ((Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (((Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
12) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
1,Int
4,Int
6]) 
            (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> ((Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (((Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
12) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
1,Int
6]) 
              (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
1,Int
4,Int
6,Int
8,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
                (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int
1,Int
4,Int
6,Int
9,Int
11]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)]) String
ys
      String
_   -> Maybe (Vector Float)
forall a. Maybe a
Nothing
 | Bool
otherwise = Maybe (Vector Float)
forall a. Maybe a
Nothing
filterInParams (P4lsf Int
nT Int
n2 Int
nL [Int]
zs String
xs) 
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
n -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) ([Int
107 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n2,Int
nT,Int
nL,Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL,Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT,Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2]  [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
zs) = 
    case String
xs of
     String
"ditonic" -> 
       if (Vector Float -> Int
forall a. Vector a -> Int
V.length (Vector Float -> Int)
-> (Vector Float -> Vector Float) -> Vector Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
        Int
i) (Vector Float -> Int) -> Vector Float -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2 
         then Maybe (Vector Float)
forall a. Maybe a
Nothing
         else 
           if (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
nT) Float -> Vector Float -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ 
            Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             then Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
               Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             else Maybe (Vector Float)
forall a. Maybe a
Nothing
     String
"tritonic" -> 
       if (Vector Float -> Int
forall a. Vector a -> Int
V.length (Vector Float -> Int)
-> (Vector Float -> Vector Float) -> Vector Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
        Int
i) (Vector Float -> Int) -> Vector Float -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3 
         then Maybe (Vector Float)
forall a. Maybe a
Nothing
         else 
           if (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
nT) Float -> Vector Float -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
3 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ 
            Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             then Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
3 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
               Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             else Maybe (Vector Float)
forall a. Maybe a
Nothing
     String
"tetratonic" -> 
       if (Vector Float -> Int
forall a. Vector a -> Int
V.length (Vector Float -> Int)
-> (Vector Float -> Vector Float) -> Vector Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
        Int
i) (Vector Float -> Int) -> Vector Float -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4 
         then Maybe (Vector Float)
forall a. Maybe a
Nothing
         else 
           if (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
nT) Float -> Vector Float -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
4 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ 
            Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             then Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
4 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
               Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             else Maybe (Vector Float)
forall a. Maybe a
Nothing
     String
"octatonic" -> 
       if (Vector Float -> Int
forall a. Vector a -> Int
V.length (Vector Float -> Int)
-> (Vector Float -> Vector Float) -> Vector Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
        Int
i) (Vector Float -> Int) -> Vector Float -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 
         then Maybe (Vector Float)
forall a. Maybe a
Nothing
         else 
           if (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
nT) Float -> Vector Float -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
8 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ 
            Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             then Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
8 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNoDup ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
zs) ([Bool] -> [(Int, Bool)]) -> [Bool] -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 Bool
True) 
               Int
i) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
             else Maybe (Vector Float)
forall a. Maybe a
Nothing
     String
_   -> Maybe (Vector Float)
forall a. Maybe a
Nothing
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
nL Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
nL Int
107 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Int
n2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"monotonic" = Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just (Float -> Vector Float
forall a. a -> Vector a
V.singleton (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
nL))
 | Bool
otherwise = Maybe (Vector Float)
forall a. Maybe a
Nothing
filterInParams (P2 Int
nL Int
n2) 
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
n -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) [Int
107 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n2,Int
nL,Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2] = Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes) 
 | Bool
otherwise = Maybe (Vector Float)
forall a. Maybe a
Nothing
filterInParams (P2s Int
nL Int
n2 String
xs) 
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
n -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) [Int
107 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n2,Int
nL,Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12] = 
    Maybe (Vector Float)
-> [(String, Maybe (Vector Float))]
-> String
-> Maybe (Vector Float)
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Maybe (Vector Float)
forall a. Maybe a
Nothing ([String]
-> [Maybe (Vector Float)] -> [(String, Maybe (Vector Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"Egyptian pentatonic", String
"Prometheus hexatonic scale", String
"Ukrainian Dorian scale", String
"augmented hexatonic scale", 
      String
"blues major pentatonic", String
"blues minor pentatonic", String
"blues scale", String
"major hexatonic scale", String
"major pentatonic", String
"minor hexatonic scale", 
        String
"minor pentatonic", String
"tritone hexatonic scale", String
"two-semitone tritone hexatonic scale", String
"whole tone scale"] ([Maybe (Vector Float)] -> [(String, Maybe (Vector Float))])
-> [Maybe (Vector Float)] -> [(String, Maybe (Vector Float))]
forall a b. (a -> b) -> a -> b
$ (Vector Float -> Maybe (Vector Float))
-> [Vector Float] -> [Maybe (Vector Float)]
forall a b. (a -> b) -> [a] -> [b]
map Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just 
          [(Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
5,Int
7,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
4,Int
6,Int
9,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
            (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
3,Int
6,Int
7,Int
9,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
3,Int
4,Int
7,Int
8,Int
11]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
              (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
5,Int
7,Int
9]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
3,Int
5,Int
8,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
                (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
3,Int
5,Int
6,Int
7,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
3,Int
5,Int
6,Int
7,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
                  (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
4,Int
5,Int
7,Int
9]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
4,Int
7,Int
9]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
                    (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
3,Int
5,Int
7,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
3,Int
5,Int
7,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
                      (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
1,Int
4,Int
6,Int
7,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
1,Int
3,Int
7,Int
8,Int
9]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes), 
                        (Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nL [Int
0,Int
2,Int
4,Int
6,Int
8,Int
10]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes)]) String
xs
 | Bool
otherwise = Maybe (Vector Float)
forall a. Maybe a
Nothing
filterInParams (P3sf Int
nT Int
nL Int
n2 String
xs) 
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
n -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) [Int
101 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL,Int
nT,Int
nL,Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL,Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT] Bool -> Bool -> Bool
&& Int
n2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = 
    case String
xs of 
      String
"Dorian tetrachord" -> 
        if (Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0,Int
1,Int
3,Int
5] then Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int
0,Int
1,Int
3,Int
5]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
6 Vector Float
notes)) else Maybe (Vector Float)
forall a. Maybe a
Nothing
      String
"Phrygian tetrachord" -> 
        if (Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0,Int
2,Int
3,Int
5] then Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int
0,Int
2,Int
3,Int
5]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
6 Vector Float
notes)) else Maybe (Vector Float)
forall a. Maybe a
Nothing
      String
"Lydian tetrachord" -> 
        if (Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0,Int
2,Int
4,Int
5] then Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int
0,Int
2,Int
4,Int
5]) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
6 Vector Float
notes)) else Maybe (Vector Float)
forall a. Maybe a
Nothing
      String
_   -> Maybe (Vector Float)
forall a. Maybe a
Nothing
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
n -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) [Int
94 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL,Int
nT,Int
nL,Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL,Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
13 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT] Bool -> Bool -> Bool
&& Int
n2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
13 = 
    Maybe (Vector Float)
-> [(String, Maybe (Vector Float))]
-> String
-> Maybe (Vector Float)
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Maybe (Vector Float)
forall a. Maybe a
Nothing ([String]
-> [Maybe (Vector Float)] -> [(String, Maybe (Vector Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"modern Aeolian mode", String
"modern Dorian mode", String
"modern Ionian mode", String
"modern Locrian mode", 
      String
"modern Lydian mode", String
"modern Mixolydian mode", String
"modern Phrygian mode"] ([Maybe (Vector Float)] -> [(String, Maybe (Vector Float))])
-> [Maybe (Vector Float)] -> [(String, Maybe (Vector Float))]
forall a b. (a -> b) -> a -> b
$ ([Int] -> Maybe (Vector Float))
-> [[Int]] -> [Maybe (Vector Float)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int -> [Int] -> Maybe (Vector Float)
h3 Int
nT Int
n2 Int
nL) [[Int
1,Int
4,Int
6,Int
9,Int
11], [Int
1,Int
4,Int
6,Int
8,Int
11], [Int
1,Int
3,Int
6,Int
8,Int
10], 
        [Int
2,Int
4,Int
7,Int
9,Int
11], [Int
1,Int
3,Int
5,Int
8,Int
10], [Int
1,Int
3,Int
6,Int
8,Int
11], [Int
2,Int
4,Int
6,Int
9,Int
11]]) String
xs
 | Bool
otherwise = Maybe (Vector Float)
forall a. Maybe a
Nothing

h3 :: Int -> Int -> Int -> [Int] -> Maybe (V.Vector Float)
h3 :: Int -> Int -> Int -> [Int] -> Maybe (Vector Float)
h3 Int
nT Int
n2 Int
nL [Int]
zs 
 | Int
nT Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nL = Vector Float -> Maybe (Vector Float)
forall a. a -> Maybe a
Just ((Int -> Float -> Bool) -> Vector Float -> Vector Float
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
i Float
_ -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int]
zs) (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
nL Int
n2 Vector Float
notes))
 | Bool
otherwise = Maybe (Vector Float)
forall a. Maybe a
Nothing

-- | For the list of @a@ from the @Ord@ class it builds a sorted in the ascending order list without duplicates.
-- 
-- > sortNoDup [2,1,4,5,6,78,7,7,5,4,3,2,5,4,2,4,54,3,5,65,4,3,54,56,43,5,2] = [1,2,3,4,5,6,7,43,54,56,65,78]
-- 
sortNoDup :: Ord a => [a] -> [a]
sortNoDup :: forall a. Ord a => [a] -> [a]
sortNoDup = [a] -> [a]
forall {a}. Eq a => [a] -> [a]
sortNoDup' ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort
  where sortNoDup' :: [a] -> [a]
sortNoDup' (a
x:x1 :: [a]
x1@(a
y:[a]
_)) 
         | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a]
sortNoDup' [a]
x1
         | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
sortNoDup' [a]
x1
        sortNoDup' (a
x:[a]
_) = [a
x]
        sortNoDup' [a]
_ = []

-- | Checks whether its first 'Int' argument does not belong to those ones that are included into the list argument on the reminders basis. 
-- The opposite to 'toneE' with the same arguments.
toneD :: Int -> Int -> Int -> [Int] -> Bool
toneD :: Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int]
zs = ((Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (((Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
12) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
zs

-- | Checks whether its first 'Int' argument does belong to those ones that are included into the list argument on the reminders basis. 
-- The opposite to 'toneD' with the same arguments.
toneE :: Int -> Int -> Int -> [Int] -> Bool
toneE :: Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int]
zs = ((Int
nL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (((Int
nT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nL) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
12) Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
zs

-- | Analogous to 'liftInEnku' lifts a frequency into a tonality (or something that can be treated alike one) specified by 'Params'. If not 
-- reasonably one exists then the result is 11440 (Hz).
liftInParams :: Float -> Params -> Float
liftInParams :: Float -> Params -> Float
liftInParams Float
x Params
params 
 | Params -> Int
lengthP Params
params Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> (Float -> Maybe Int) -> Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Maybe Int
whichOctaveG (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float
x) = Float
11440.0 
 | Bool
otherwise = 
    Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex (Maybe (Vector Float) -> Vector Float
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Vector Float) -> Vector Float)
-> (Params -> Maybe (Vector Float)) -> Params -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe (Vector Float)
filterInParams (Params -> Vector Float) -> Params -> Vector Float
forall a b. (a -> b) -> a -> b
$ Params
params) (Vector Float -> Int
forall a. Ord a => Vector a -> Int
V.minIndex (Vector Float -> Int)
-> ((Int -> Float) -> Vector Float) -> (Int -> Float) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> Vector Float -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
log (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Float
t -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)) (Vector Float -> Vector Float)
-> ((Int -> Float) -> Vector Float)
-> (Int -> Float)
-> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int -> Float) -> Vector Float
forall a. Int -> (Int -> a) -> Vector a
V.generate (Params -> Int
lengthP Params
params) ((Int -> Float) -> Int) -> (Int -> Float) -> Int
forall a b. (a -> b) -> a -> b
$ 
      (\Int
i -> Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Float -> Maybe Int
whichOctaveG Float
x)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
2 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Params -> Int
lengthP Params
params))))

-- | Application of the 'liftInParams' to a 'V.Vector'. 
liftInParamsV :: Params -> V.Vector Float -> V.Vector Float
liftInParamsV :: Params -> Vector Float -> Vector Float
liftInParamsV Params
params = (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
11440.0) (Vector Float -> Vector Float)
-> (Vector Float -> Vector Float) -> Vector Float -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> Vector Float -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Float
x -> Float -> Params -> Float
liftInParams Float
x Params
params)

-- | Gets a length of the 'V.Vector' of 'Float' being represented as 'Params'. This is a number of the notes contained in the 'Params'.
lengthP :: Params -> Int
lengthP :: Params -> Int
lengthP = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (Params -> Maybe Int) -> Params -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Float -> Int) -> Maybe (Vector Float) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Float -> Int
forall a. Vector a -> Int
V.length (Maybe (Vector Float) -> Maybe Int)
-> (Params -> Maybe (Vector Float)) -> Params -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe (Vector Float)
filterInParams

-- | Check whether a given 'Float' value (frequency of a note) is in the vector of Floats that corresponds to the given 'Params'.
elemP :: Float -> Params -> Bool
elemP :: Float -> Params -> Bool
elemP Float
note = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> (Params -> Maybe Bool) -> Params -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Float -> Bool) -> Maybe (Vector Float) -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float
note Float -> Vector Float -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem`) (Maybe (Vector Float) -> Maybe Bool)
-> (Params -> Maybe (Vector Float)) -> Params -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe (Vector Float)
filterInParams

-- | Check whether a given 'Float' value (frequency of the closest note to the given frequency) is in the vector of Floats that 
-- corresponds to the given 'Params'.
elemCloseP :: Float -> Params -> Bool
elemCloseP :: Float -> Params -> Bool
elemCloseP Float
note = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> (Params -> Maybe Bool) -> Params -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Float -> Bool) -> Maybe (Vector Float) -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float -> Float
closestNote Float
note Float -> Vector Float -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem`) (Maybe (Vector Float) -> Maybe Bool)
-> (Params -> Maybe (Vector Float)) -> Params -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe (Vector Float)
filterInParams

-- | A way to show not the (somewhat algebraic) structure of the 'Params' (as the usual 'show' does), but the contained frequencies in it. 
showD :: Params -> String
showD :: Params -> String
showD = Maybe (Vector Float) -> String
forall a. Show a => a -> String
show (Maybe (Vector Float) -> String)
-> (Params -> Maybe (Vector Float)) -> Params -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe (Vector Float)
filterInParams 

-- | Check whether for the given arguments there are the notes and whether 'String' is a name signature for the scale in 'Params' (can they be used 
-- together to correspond to a non-empty set of notes).
isStrParams :: String -> Params -> Bool
isStrParams :: String -> Params -> Bool
isStrParams String
xs (P2s Int
x Int
y String
zs) = if Maybe (Vector Float) -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe (Vector Float)
filterInParams (Int -> Int -> String -> Params
P2s Int
x Int
y String
zs)) then String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
zs else Bool
False
isStrParams String
xs (P3sf Int
x Int
y Int
z String
zs) = if Maybe (Vector Float) -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe (Vector Float)
filterInParams (Int -> Int -> Int -> String -> Params
P3sf Int
x Int
y Int
z String
zs)) then String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
zs else Bool
False
isStrParams String
xs (P4lsf Int
x Int
y Int
z [Int]
ts String
zs) = if Maybe (Vector Float) -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe (Vector Float)
filterInParams (Int -> Int -> Int -> [Int] -> String -> Params
P4lsf Int
x Int
y Int
z [Int]
ts String
zs)) then String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
zs else Bool
False
isStrParams String
xs (P32sf Int
x Int
y Int
z String
zs String
ys) = if Maybe (Vector Float) -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe (Vector Float)
filterInParams (Int -> Int -> Int -> String -> String -> Params
P32sf Int
x Int
y Int
z String
zs String
ys)) then (String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
zs Bool -> Bool -> Bool
|| String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ys Bool -> Bool -> Bool
|| String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
ys String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
zs)) else Bool
False
isStrParams String
_ Params
_ = Bool
False

-- | Check whether for the given arguments there are the notes and whether list of 'Int' is a part of the constructed 'Params' (can they be used 
-- together to correspond to a non-empty set of notes).
isListParams :: [Int] -> Params -> Bool
isListParams :: [Int] -> Params -> Bool
isListParams [Int]
xs (P4lsf Int
x Int
y Int
z [Int]
ts String
zs) = if Maybe (Vector Float) -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe (Vector Float)
filterInParams (Int -> Int -> Int -> [Int] -> String -> Params
P4lsf Int
x Int
y Int
z [Int]
ts String
zs)) then [Int]
xs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
ts else Bool
False
isListParams [Int]
xs (P3lf Int
x Int
y [Int]
zs) = if Maybe (Vector Float) -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe (Vector Float)
filterInParams (Int -> Int -> [Int] -> Params
P3lf Int
x Int
y [Int]
zs)) then [Int]
xs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
zs else Bool
False
isListParams [Int]
_ Params
_ = Bool
False

-- | Generates melody for the given parameters. The idea is that every application of the function @f :: Float -> OvertonesO@ to its argument 
-- possibly can produce multiple overtones being represented as 'V.Vector' of tuples of pairs of 'Float'. We can use the first element in the 
-- tuple to obtain a new sound parameters and the second one -- to obtain its new duration in the melody. Additional function @g :: Float -> Float@ 
-- is used to avoid the effect of becoming less and less -- closer to the zero for the higher overtones so the durations will become also less. 
-- Besides it allows to rescale the durations in a much more convenient way. 
-- 
-- The first 'Float' parameter is a multiplication coefficient to increase or to decrease the durations (values with an absolute values greater than 
-- one correspond to increasing inside the @g@. function applied afterwards with function composition and the values with an absolute values less 
-- than one and not equal to zero correspond to decreasing inside the @g@ function. 
-- The second 'Float' parameter is a usual frequency which is used instead of the 11440.0 (Hz) value. 
-- The third 'Float' parameter is a main argument -- the frequency for which the 'OvertonesO' are generated as a first step of the computation. 
overMeloPar :: (Float -> OvertonesO) -> (Float -> Float) -> Params -> Float -> Float -> Float -> IO ()
overMeloPar :: (Float -> OvertonesO)
-> (Float -> Float) -> Params -> Float -> Float -> Float -> IO ()
overMeloPar Float -> OvertonesO
f Float -> Float
g Params
params Float
coeff Float
freq0 Float
freq = do 
  let v :: OvertonesO
v = Float -> OvertonesO
f Float
freq
      vFreqs :: Vector Float
vFreqs = ((Float, Float) -> Float) -> OvertonesO -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((\Float
z -> if Float
z Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
11440.0 then Float
freq0 else Float
z) (Float -> Float)
-> ((Float, Float) -> Float) -> (Float, Float) -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Params -> Float) -> Params -> Float -> Float
forall a b c. (a -> b -> c) -> b -> a -> c
flip Float -> Params -> Float
liftInParams Params
params (Float -> Float)
-> ((Float, Float) -> Float) -> (Float, Float) -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Float) -> Float
forall a b. (a, b) -> a
fst) OvertonesO
v
      vD :: Vector Float
vD = ((Float, Float) -> Float) -> OvertonesO -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Float -> Float
g (Float -> Float)
-> ((Float, Float) -> Float) -> (Float, Float) -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
coeff) (Float -> Float)
-> ((Float, Float) -> Float) -> (Float, Float) -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Float) -> Float
forall a b. (a, b) -> b
snd) OvertonesO
v
      v2 :: Vector OvertonesO
v2 = (Float -> OvertonesO) -> Vector Float -> Vector OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map Float -> OvertonesO
f Vector Float
vFreqs
      vS :: Vector String
vS = (Float -> String) -> Vector Float -> Vector String
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Float
z -> 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
z) String
"") Vector Float
vD
      h42 :: a -> ((a, b), OvertonesO, a, String) -> IO ()
h42 a
j ((a, b)
x,OvertonesO
v3,a
y,String
ts) 
        | a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y a
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = do 
           (_,_,herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"-r22050", String
"-n", String
"testA.wav", String
"synth", String
ts,String
"sine",Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) String
""] String
""
           print herr
           partialTest_k v3 0 ts
           mixTest
           renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav"
        | a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y a
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = do 
           (_,_,herr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) [String
"-r22050", String
"-n", String
"result.wav", String
"synth", String
ts,String
"sine",Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) String
"",String
"vol",String
"0"] String
"" 
           putStr herr
           renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav"
        | Bool
otherwise = String -> IO ()
putStrLn String
"Zero length of the sound! " 
  (Int -> ((Float, Float), OvertonesO, Float, String) -> IO ())
-> Vector ((Float, Float), OvertonesO, Float, String) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
j ((Float, Float), OvertonesO, Float, String)
zz -> Int -> ((Float, Float), OvertonesO, Float, String) -> IO ()
forall {a} {a} {a} {b}.
(RealFloat a, Show a, Ord a, Fractional a) =>
a -> ((a, b), OvertonesO, a, String) -> IO ()
h42 Int
j ((Float, Float), OvertonesO, Float, String)
zz) (Vector ((Float, Float), OvertonesO, Float, String) -> IO ())
-> (Vector String
    -> Vector ((Float, Float), OvertonesO, Float, String))
-> Vector String
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO
-> Vector OvertonesO
-> Vector Float
-> Vector String
-> Vector ((Float, Float), OvertonesO, Float, String)
forall a b c d.
Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d)
V.zip4 OvertonesO
v Vector OvertonesO
v2 Vector Float
vD (Vector String -> IO ()) -> Vector String -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector String
vS

-- | A default way to get 'Durations' for the sounds up to 0.35.2.0 version of the package including. It is based on the number of Ukrainian 
-- sounds representations (see, 'convertToProperUkrainian') in a Ukrainian syllables or somewhat generated by the same rules as they. 
-- The rhythm using the function is very often not binary but its ratios are almost always a ratios of the small natural numbers (1, 2, 3, 4, 5, 6, 7 etc.).
str2DurationsDef :: Int -> String -> Float -> Durations
str2DurationsDef :: Int -> String -> Float -> Vector Float
str2DurationsDef Int
n String
zs Float
y = 
  let ([Int]
t, [Int]
ws) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([Int] -> ([Int], [Int]))
-> (String -> [Int]) -> String -> ([Int], [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [Int]
syllableStr Int
n (String -> ([Int], [Int])) -> String -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ String
zs in (Int -> Float) -> Vector Int -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Int
yy -> Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
yy Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ws) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
t)) (Vector Int -> Vector Float)
-> ([Int] -> Vector Int) -> [Int] -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ([Int] -> Vector Float) -> [Int] -> Vector Float
forall a b. (a -> b) -> a -> b
$ [Int]
ws 
  
apply6GSilentFile :: FilePath -> Float -> Float -> IO ()
apply6GSilentFile :: String -> Float -> Float -> IO ()
apply6GSilentFile String
file Float
limV Float
vol = do
  upp <- String -> IO Int
upperBnd String
file
  ampL2 <- fmap ((\String
zz -> String -> Float
forall a. Read a => String -> a
read String
zz::Float) . fst) (selMaxAbs file (0,upp))
  if compare (abs ampL2) (abs limV) /= GT then putStr ""
  else apply6Gf vol file

-- | Apply volume adjustment to the sound file. It must not be silent. Otherwise, it leads to likely noise sounding or errors.
apply6Gf :: Float -> FilePath -> IO ()
apply6Gf :: Float -> String -> IO ()
apply6Gf Float
vol 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) Float
vol String
""]  

-- | Function is used to generate a rhythm of the resulting file \'end.wav\' from the Ukrainian text and a number of sounds either in the syllables or in the words without vowels.
syllableStr :: Int -> String -> [Int]
syllableStr :: Int -> String -> [Int]
syllableStr Int
n String
xs =
  let ps :: [Int]
ps = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
cycle ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Int8]] -> [Int]) -> [[[Int8]]] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Int8] -> Int) -> [[Int8]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[[Int8]]] -> [Int]) -> (String -> [[[Int8]]]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Int8]]]
createSyllablesUkrS (String -> [Int]) -> String -> [Int]
forall a b. (a -> b) -> a -> b
$ String
xs
      y :: Int
y  = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ps in
       case Int
y of
         Int
0 -> [Int
0]
         Int
_ -> Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ps  

-- | Similar to 'overSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller
-- by absolute value than 0.001. 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_Sf'.
overSoXSynth2FDN_Sf :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
overSoXSynth2FDN_Sf :: (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
overSoXSynth2FDN_Sf Float -> OvertonesO
f (Float
x, Float
y) = (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> IO ()
overSoXSynth2FDN_Sf3 Float -> OvertonesO
f (Float
x, Float
y, Float
0.001)

-- | Similar to 'overSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller
-- than the third 'Float' parameter by an absolute value in the triple of @Float@'s. 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_Sf3'.
overSoXSynth2FDN_Sf3 :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> IO ()
overSoXSynth2FDN_Sf3 :: (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> IO ()
overSoXSynth2FDN_Sf3 Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j String
zs = (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> String
-> Vector Float
-> String
-> IO ()
overSoXSynth2FDN_Sf32G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j String
zs Vector Float
forall a. Vector a
V.empty []

-- | 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_Sf32G :: (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> V.Vector Float -> String -> IO ()
overSoXSynth2FDN_Sf32G :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> String
-> Vector Float
-> String
-> IO ()
overSoXSynth2FDN_Sf32G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j String
zs Vector Float
vdB String
ys
 | [Int8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Int8] -> Bool) -> (String -> [Int8]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int8]
convertToProperUkrainianI8 (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
zs = Float -> IO ()
overSoXSynth Float
x
 | Bool
otherwise = do
    let l0 :: Int
l0    = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
zs
    Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Float
-> String
-> IO ()
soundGenF32G ([Float -> Float] -> Vector (Float -> Float)
forall a. [a] -> Vector a
V.fromList [\Float
x2 -> Float -> Float
closestNote (if Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x2 else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0),\Float
x2 -> 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 (String -> Vector Int
intervalsFromString String
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 -> Float
closestNote (if Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x2 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 (String -> Vector Int
intervalsFromString String
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 -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Vector Float
vdB String
ys
    if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys then IO ()
mixTest else String -> IO ()
mixTest2G String
ys

-- | Function is used to get numbers of intervals from a Ukrainian 'String'. It is used internally in the 'uniqOverSoXSynthN4' function.
intervalsFromString :: String -> Intervals
intervalsFromString :: String -> Vector Int
intervalsFromString = Vector Int -> Vector String -> Vector Int
vStrToVIntG Vector Int
defInt (Vector String -> Vector Int)
-> (String -> Vector String) -> String -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int8] -> Vector String
newRepresentation ([Int8] -> Vector String)
-> (String -> [Int8]) -> String -> Vector String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int8]
convertToProperUkrainianI8

-- | Generatlized version of the 'vStrToVInt' with a possibility to specify your own 'Intervals'.
vStrToVIntG :: Intervals -> V.Vector String -> Intervals
vStrToVIntG :: Vector Int -> Vector String -> Vector Int
vStrToVIntG Vector Int
v = (String -> Int) -> Vector String -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Vector Int -> String -> Int
strToIntG Vector Int
v)

-- | Default values for 'strToInt'. All the intervals are not greater than one full octave.
defInt :: Intervals
defInt :: Vector Int
defInt = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList [Int
12,Int
4,Int
7,Int
3,Int
4,Int
5,Int
5,Int
12,Int
3,Int
8,Int
12,Int
7,Int
10,Int
7,Int
7,Int
7,Int
12,Int
10,Int
7,Int
10,Int
2,Int
12,Int
2,Int
2,Int
11,Int
11,Int
1,Int
12,Int
9]
{-# INLINE defInt #-}

-- | Generatlized version of the 'strToInt' with a possibility to specify your own 'Intervals'.
strToIntG :: Intervals -> String -> Int
strToIntG :: Vector Int -> String -> Int
strToIntG Vector Int
v =
  Int -> [(String, Int)] -> String -> Int
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Int
0 ([String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String
"а",String
"б",String
"в",String
"г",String
"д",String
"дж",String
"дз",String
"е",String
"ж",String
"з",String
"и",String
"й",String
"к",String
"л",String
"м",String
"н",String
"о",String
"п",String
"р",String
"с",String
"т",String
"у",String
"ф",String
"х",String
"ц",String
"ч",String
"ш",String
"і",String
"ґ"]) ([Int] -> [(String, Int)])
-> (Vector Int -> [Int]) -> Vector Int -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Int -> [Int]
forall a. Vector a -> [a]
V.toList (Vector Int -> [(String, Int)]) -> Vector Int -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$ Vector Int
v)
{-# INLINE strToIntG #-}

-- | Generalized variant of the 'soundGenF31G' with a possibility to specify sound quality using the 'String' argument. For more information,
-- please, refer to 'soxBasicParams'.
soundGenF32G :: V.Vector (Float -> Float) -> V.Vector Float -> V.Vector Int -> (Float -> OvertonesO) -> (Float, Float, Float) -> Int ->
  V.Vector Float -> String -> IO ()
soundGenF32G :: Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Vector Float
-> String
-> 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 String
ys = do
  let vD :: Vector (Maybe Float)
vD = Vector (Float -> Float)
-> Vector Float -> Vector Int -> Vector (Maybe Float)
helpF1 Vector (Float -> Float)
vf Vector Float
vd Vector Int
vi   -- Vector of notes played simultaneously (e. g. just one, interval, accord etc.)
      vDz :: Vector Float
vDz = (Maybe Float -> Maybe Float)
-> Vector (Maybe Float) -> Vector Float
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe Maybe Float -> Maybe Float
forall a. a -> a
id Vector (Maybe Float)
vD -- The previous one without Nothings and Justs
      vNotes :: Vector OvertonesO
vNotes = (Float -> OvertonesO)
-> Float -> Vector (Maybe Float) -> Vector OvertonesO
doubleVecFromVecOfFloat Float -> OvertonesO
f Float
t0 ((Float -> Maybe Float) -> Vector Float -> Vector (Maybe Float)
forall a b. (a -> b) -> Vector a -> Vector b
V.map Float -> Maybe Float
forall a. a -> Maybe a
Just Vector Float
vDz) -- Vector of vectors of pairs (freq,ampl) -- notes and their absence (V.empty) with overtones
      ts :: String
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) String
"" -- duration of the sound to be generated
  (Int -> Float -> IO ()) -> Vector Float -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i Float
_ -> 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) ((if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
vdB 
       then [String] -> [String]
forall a. a -> a
id else (\[String]
wwws -> [String] -> Float -> [String]
adjust_dbVol [String]
wwws (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) [String
"-r22050", String
"-n", String
"test" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
helpF0 Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav", String
"synth",String
ts,
         String
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vDz Int
i) String
"",String
"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 String
"1.0" else String
"0"])) String
""
    partialTest_k2G (V.unsafeIndex vNotes i) i ts vdB ys) Vector Float
vDz      

helpF0 :: Int -> String
helpF0 :: Int -> String
helpF0 =
  String -> [(Int, String)] -> Int -> String
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' String
"ZZ0" ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([String] -> [(Int, String)]) -> [String] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ ((Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) String
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> [String]) -> String -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
z -> (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char
zChar -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[])) String
"ABCDEFGHIJKLMNOPQRSTUVWXYZ")
     String
"ABCDEFGHIJKLMNOPQRSTUVWXYZ")) 

helpF1 :: V.Vector (Float -> Float) -> V.Vector Float -> V.Vector Int -> V.Vector (Maybe Float)
helpF1 :: Vector (Float -> Float)
-> Vector Float -> Vector Int -> Vector (Maybe Float)
helpF1 Vector (Float -> Float)
vf Vector Float
vd =
  ((Float -> Float, Float, Int) -> Maybe Float)
-> Vector (Float -> Float, Float, Int) -> Vector (Maybe Float)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float -> Float
f1,Float
x,Int
i2) ->
    case Int
i2 of
      Int
0 -> Maybe Float
forall a. Maybe a
Nothing
      Int
_ -> Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
f1 Float
x) (Vector (Float -> Float, Float, Int) -> Vector (Maybe Float))
-> (Vector Int -> Vector (Float -> Float, Float, Int))
-> Vector Int
-> Vector (Maybe Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Float -> Float)
-> Vector Float
-> Vector Int
-> Vector (Float -> Float, Float, Int)
forall a b c. Vector a -> Vector b -> Vector c -> Vector (a, b, c)
V.zip3 Vector (Float -> Float)
vf Vector Float
vd

-- | Generates a 'V.Vector' of 'OvertonesO' that represents the sound. 
doubleVecFromVecOfFloat :: (Float -> OvertonesO) -> Float -> V.Vector (Maybe Float) -> V.Vector OvertonesO
doubleVecFromVecOfFloat :: (Float -> OvertonesO)
-> Float -> Vector (Maybe Float) -> Vector OvertonesO
doubleVecFromVecOfFloat Float -> OvertonesO
f Float
t0 =
  (Maybe Float -> OvertonesO)
-> Vector (Maybe Float) -> Vector OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Maybe Float
note1 -> 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.filter (\(Float
_,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
t0 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
. Float -> OvertonesO
f (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)