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

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

module Composition.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_Sf3GPar
  , overSoXSynthGen2FDN_Sf3G2GPar
  -- * Creating melody from overtones
  , overMeloPar
  , overMeloPar2G
  -- * Additional functions
  , str2DurationsDef
  , signsFromString
  , apply6Gf
  , apply6GSilentFile
  , vStrToVIntG
  , strToIntG
  , defInt
  , syllableStr
  , overSoXSynth2FDN_Sf32G
  , intervalsFromString
  , soundGenF32G
  , helpF0
  , helpF1
  , doubleVecFromVecOfFloat
) where

import CaseBi.Arr (getBFstLSorted',getBFstL')
import Numeric
import Data.List (sort,zip4,elemIndex)
import Data.Maybe (isNothing,fromJust,isJust,fromMaybe,mapMaybe)
import GHC.Arr
import System.Process
import System.Exit
import EndOfExe
import System.Directory
import Languages.Phonetic.Ukrainian.Syllable.Arr
import Melodics.ByteString.Ukrainian.Arr
import Sound.SoXBasics (upperBnd,selMaxAbs)
import MMSyn7l
import qualified Data.Foldable as F
import Composition.Sound.IntermediateF
import Composition.Sound.Functional.Basics
import Data.Foldable.Ix

-- | 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
/= :: Params -> Params -> Bool
$c/= :: Params -> Params -> Bool
== :: Params -> Params -> Bool
$c== :: 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
min :: Params -> Params -> Params
$cmin :: Params -> Params -> Params
max :: Params -> Params -> Params
$cmax :: Params -> Params -> Params
>= :: Params -> Params -> Bool
$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
compare :: Params -> Params -> Ordering
$ccompare :: Params -> Params -> Ordering
$cp1Ord :: Eq 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
showList :: [Params] -> ShowS
$cshowList :: [Params] -> ShowS
show :: Params -> String
$cshow :: Params -> String
showsPrec :: Int -> Params -> ShowS
$cshowsPrec :: Int -> 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 = Array Int Float

-- | Is used to represent a set of volumes in the amplitude scale for SoX \"vol\" effect.
type Strengths = Array Int 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 = Array Int 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). \"сь\" and \"ць\" gives "0". Other symbols are not taken into account.
signsFromString :: Int -> String -> Array Int Int
signsFromString :: Int -> String -> Array Int Int
signsFromString Int
n1 =
  (\[Int]
rs -> (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Int]
rs) ([Int] -> Array Int Int)
-> (String -> [Int]) -> String -> Array Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n1 ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[UZPP Char PhoneticType]] -> [Int])
-> [[[UZPP Char PhoneticType]]] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((UZPP Char PhoneticType -> Int)
-> [UZPP Char PhoneticType] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case
      UZ Char
_ PhoneticType
W -> Int
1
      UZ Char
_ PhoneticType
D -> Int
1
      UZ Char
_ PhoneticType
K -> Int
1
      UZ Char
_ PhoneticType
L -> (-Int
1)
      UZ Char
_ PhoneticType
M -> (-Int
1)
      UZ Char
_ PhoneticType
S -> (-Int
1)
      UZ Char
_ PhoneticType
O -> (-Int
1)
      UZPP Char PhoneticType
_ -> Int
0) ([UZPP Char PhoneticType] -> [Int])
-> ([[UZPP Char PhoneticType]] -> [UZPP Char PhoneticType])
-> [[UZPP Char PhoneticType]]
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[UZPP Char PhoneticType]] -> [UZPP Char PhoneticType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[[UZPP Char PhoneticType]]] -> [Int])
-> (String -> [[[UZPP Char PhoneticType]]]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP Char PhoneticType]]]
createSyllablesUkrS (String -> [[[UZPP Char PhoneticType]]])
-> ShowS -> String -> [[[UZPP Char PhoneticType]]]
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. [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
-> Durations
-> String
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> String -> IO ())
-> IO ()
overSoXSynthGen2FDN_SG4GPar String
file Params
params Float -> OvertonesO
f Float
y Durations
arr2 String
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
h = do
  Int
n <- String -> IO Int
duration1000 String
file
  [Int]
vecA <- String -> Int -> IO [Int]
freqsFromFile String
file Int
n
  let vecB :: [Float]
vecB = Params -> [Float] -> [Float]
liftInParamsV Params
params ([Float] -> [Float]) -> ([Int] -> [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Int]
vecA
      zeroN :: Int
zeroN = [Float] -> Int
forall a. [a] -> Int
numVZeroesPre [Float]
vecB in ((Int, Float) -> IO ()) -> [(Int, Float)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
j, Float
x) -> do
        (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
h Float -> OvertonesO
f (Float
x, (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
arr2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Durations -> Int
forall i e. Array i e -> Int
numElements Durations
arr2))) 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") ([(Int, Float)] -> IO ())
-> ([Float] -> [(Int, Float)]) -> [Float] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> IO ()) -> [Float] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Float]
vecB
  IO ()
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
-> Durations
-> String
-> ((Float -> OvertonesO)
    -> (Float, Float) -> Int -> String -> IO ())
-> Durations
-> Float
-> IO ()
overSoXSynthGen2FDN_SG6GPar String
file Params
params Float -> OvertonesO
f Float
y Durations
v2 String
wws (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
h Durations
v6 Float
limV
 | Durations -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null Durations
v6 = String -> IO ()
putStrLn String
"You did not provide a volume adjustments array! "
 | Bool
otherwise = do
    Int
n <- String -> IO Int
duration1000 String
file
    [Int]
xs <- String -> Int -> IO [Int]
freqsFromFile String
file Int
n
    let ys :: [Float]
ys = Params -> [Float] -> [Float]
liftInParamsV Params
params ([Float] -> [Float]) -> ([Int] -> [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Int]
xs
        !l6 :: Int
l6 = Durations -> Int
forall i e. Array i e -> Int
numElements Durations
v6
        !l2 :: Int
l2 = Durations -> Int
forall i e. Array i e -> Int
numElements Durations
v2
        zeroN :: Int
zeroN = [Float] -> Int
forall a. [a] -> Int
numVZeroesPre [Float]
ys in ((Int, Float) -> IO ()) -> [(Int, Float)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
j, Float
x) -> do
          (Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()
h Float -> OvertonesO
f (Float
x, (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l2))) 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 (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
v6 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l6))) ([(Int, Float)] -> IO ())
-> ([Float] -> [(Int, Float)]) -> [Float] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> IO ()) -> [Float] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Float]
ys
    IO ()
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
  Int
n <- String -> IO Int
duration1000 String
file
  [Int]
vecA <- String -> Int -> IO [Int]
freqsFromFile String
file Int
n
  let vecB :: [Float]
vecB = Params -> [Float] -> [Float]
liftInParamsV Params
params ([Float] -> [Float]) -> ([Int] -> [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Int]
vecA
      zeroN :: Int
zeroN = [Float] -> Int
forall a. [a] -> Int
numVZeroesPre [Float]
vecB
      v2 :: Durations
v2    = Int -> String -> Float -> Durations
str2DurationsDef Int
n String
zs Float
y
      !l2 :: Int
l2 = Durations -> Int
forall i e. Array i e -> Int
numElements Durations
v2 in ((Int, Float) -> IO ()) -> [(Int, Float)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
j, Float
x) -> do
        (Float -> OvertonesO)
-> (Float, Float) -> Int -> String -> String -> IO ()
h Float -> OvertonesO
f (Float
x, (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l2))) 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") ([(Int, Float)] -> IO ())
-> ([Float] -> [(Int, Float)]) -> [Float] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> IO ()) -> [Float] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Float]
vecB
  String -> IO ()
endFromResult2G String
ys

-- | 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
  Int
n <- String -> IO Int
duration1000 String
file
  [Int]
vecA <- String -> Int -> IO [Int]
freqsFromFile String
file Int
n
  let vecB :: [Float]
vecB = Params -> [Float] -> [Float]
liftInParamsV Params
params ([Float] -> [Float]) -> ([Int] -> [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Int]
vecA
      zeroN :: Int
zeroN = [Float] -> Int
forall a. [a] -> Int
numVZeroesPre [Float]
vecB
      v2 :: Durations
v2    = Int -> String -> Float -> Durations
str2DurationsDef Int
n String
zs Float
y
      !l2 :: Int
l2 = Durations -> Int
forall i e. Array i e -> Int
numElements Durations
v2 in ((Int, Float) -> IO ()) -> [(Int, Float)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
j, Float
x) -> do
        (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> IO ()
h Float -> OvertonesO
f (Float
x, (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l2)), 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") ([(Int, Float)] -> IO ())
-> ([Float] -> [(Int, Float)]) -> [Float] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> IO ()) -> [Float] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Float]
vecB
  IO ()
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
  Int
n <- String -> IO Int
duration1000 String
file
  [Int]
vecA <- String -> Int -> IO [Int]
freqsFromFile String
file Int
n
  let vecB :: [Float]
vecB = Params -> [Float] -> [Float]
liftInParamsV Params
params ([Float] -> [Float]) -> ([Int] -> [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Int]
vecA
      zeroN :: Int
zeroN = [Float] -> Int
forall a. [a] -> Int
numVZeroesPre [Float]
vecB
      v2 :: Durations
v2    = Int -> String -> Float -> Durations
str2DurationsDef Int
n String
zs Float
y
      !l2 :: Int
l2 = Durations -> Int
forall i e. Array i e -> Int
numElements Durations
v2 in ((Int, Float) -> IO ()) -> [(Int, Float)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
j, Float
x) -> do
        (Float -> OvertonesO)
-> (Float, Float, Float) -> Int -> String -> String -> IO ()
h Float -> OvertonesO
f (Float
x, (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
v2 (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
l2)), 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") ([(Int, Float)] -> IO ())
-> ([Float] -> [(Int, Float)]) -> [Float] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> IO ()) -> [Float] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Float]
vecB
  String -> IO ()
endFromResult2G String
ys

-- | A way to get from a 'Params' a corresponding 'Array' 'Int' 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 (Array Int Float)
filterInParams :: Params -> Maybe Durations
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 -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) ([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 ((Int, Float) -> Bool) -> [(Int, Float)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
i) ([(Int, Float)] -> Bool)
-> (Durations -> [(Int, Float)]) -> Durations -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Bool) -> Durations -> Bool
forall a b. (a -> b) -> a -> b
$ Durations
notes
      then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes)
      else Maybe Durations
forall a. Maybe a
Nothing
 | Bool
otherwise = Maybe Durations
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 -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) [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 Durations
-> [(String, Maybe Durations)] -> String -> Maybe Durations
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Maybe Durations
forall a. Maybe a
Nothing ([String] -> [Maybe Durations] -> [(String, Maybe Durations)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"FloatH",String
"H",String
"Full",String
"Full moll",String
"M",String
"N"] ([Maybe Durations] -> [(String, Maybe Durations)])
-> ([Durations] -> [Maybe Durations])
-> [Durations]
-> [(String, Maybe Durations)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Durations -> Maybe Durations) -> [Durations] -> [Maybe Durations]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([Durations] -> [(String, Maybe Durations)])
-> [Durations] -> [(String, Maybe Durations)]
forall a b. (a -> b) -> a -> b
$
        [[(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes]) String
ys
      String
"moll" -> Maybe Durations
-> [(String, Maybe Durations)] -> String -> Maybe Durations
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Maybe Durations
forall a. Maybe a
Nothing ([String] -> [Maybe Durations] -> [(String, Maybe Durations)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String
"FloatH1",String
"H",String
"Full",String
"Full dur",String
"M",String
"N"] ([Maybe Durations] -> [(String, Maybe Durations)])
-> ([Durations] -> [Maybe Durations])
-> [Durations]
-> [(String, Maybe Durations)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Durations -> Maybe Durations) -> [Durations] -> [Maybe Durations]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([Durations] -> [(String, Maybe Durations)])
-> [Durations] -> [(String, Maybe Durations)]
forall a b. (a -> b) -> a -> b
$
        [[(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$
            Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes]) String
ys
      String
_   -> Maybe Durations
forall a. Maybe a
Nothing
 | Bool
otherwise = Maybe Durations
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 -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) ([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 ([(Int, Float)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Int, Float)] -> Int)
-> ([(Int, Float)] -> [(Int, Float)]) -> [(Int, Float)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> Int) -> [(Int, Float)] -> Int
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall a b. (a -> b) -> a -> b
$ Durations
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2
         then Maybe Durations
forall a. Maybe a
Nothing
         else
           if (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
nT) Float -> [Float] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Int, Float) -> Float) -> [(Int, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Float) -> Float
forall a b. (a, b) -> b
snd ([(Int, Float)] -> [Float])
-> (Durations -> [(Int, Float)]) -> Durations -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [Float]) -> Durations -> [Float]
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
               Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             else Maybe Durations
forall a. Maybe a
Nothing
     String
"tritonic" ->
       if ([(Int, Float)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Int, Float)] -> Int)
-> ([(Int, Float)] -> [(Int, Float)]) -> [(Int, Float)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
        Int
i) ([(Int, Float)] -> Int) -> [(Int, Float)] -> Int
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall a b. (a -> b) -> a -> b
$ Durations
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3
         then Maybe Durations
forall a. Maybe a
Nothing
         else
           if (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
nT) Float -> [Float] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Int, Float) -> Float) -> [(Int, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Float) -> Float
forall a b. (a, b) -> b
snd ([(Int, Float)] -> [Float])
-> (Durations -> [(Int, Float)]) -> Durations -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [Float]) -> Durations -> [Float]
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
               Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             else Maybe Durations
forall a. Maybe a
Nothing
     String
"tetratonic" ->
       if ([(Int, Float)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Int, Float)] -> Int)
-> ([(Int, Float)] -> [(Int, Float)]) -> [(Int, Float)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
        Int
i) ([(Int, Float)] -> Int) -> [(Int, Float)] -> Int
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall a b. (a -> b) -> a -> b
$ Durations
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4
         then Maybe Durations
forall a. Maybe a
Nothing
         else
           if (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
nT) Float -> [Float] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Int, Float) -> Float) -> [(Int, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Float) -> Float
forall a b. (a, b) -> b
snd ([(Int, Float)] -> [Float])
-> (Durations -> [(Int, Float)]) -> Durations -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [Float]) -> Durations -> [Float]
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
               Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             else Maybe Durations
forall a. Maybe a
Nothing
     String
"octatonic" ->
       if ([(Int, Float)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Int, Float)] -> Int)
-> ([(Int, Float)] -> [(Int, Float)]) -> [(Int, Float)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
        Int
i) ([(Int, Float)] -> Int) -> [(Int, Float)] -> Int
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall a b. (a -> b) -> a -> b
$ Durations
notes)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8
         then Maybe Durations
forall a. Maybe a
Nothing
         else
           if (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
nT) Float -> [Float] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Int, Float) -> Float) -> [(Int, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Float) -> Float
forall a b. (a, b) -> b
snd ([(Int, Float)] -> [Float])
-> (Durations -> [(Int, Float)]) -> Durations -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> [Float]) -> Durations -> [Float]
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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 -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
n2 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True)
               Int
i) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes)
             else Maybe Durations
forall a. Maybe a
Nothing
     String
_   -> Maybe Durations
forall a. Maybe a
Nothing
 | Int
nL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
nL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
107 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" = Durations -> Maybe Durations
forall a. a -> Maybe a
Just ((Int, Int) -> [Float] -> Durations
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
0) ([Float] -> Durations) -> (Float -> [Float]) -> Float -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[]) (Float -> Durations) -> Float -> Durations
forall a b. (a -> b) -> a -> b
$ (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
nL))
 | Bool
otherwise = Maybe Durations
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 -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) [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] = Durations -> Maybe Durations
forall a. a -> Maybe a
Just ((\[Float]
rs -> (Int, Int) -> [Float] -> Durations
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Float]
rs) ([Float] -> Durations)
-> (Durations -> [Float]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes)
 | Bool
otherwise = Maybe Durations
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 -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) [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 Durations
-> [(String, Maybe Durations)] -> String -> Maybe Durations
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Maybe Durations
forall a. Maybe a
Nothing ([String] -> [Maybe Durations] -> [(String, Maybe Durations)]
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 Durations] -> [(String, Maybe Durations)])
-> ([Durations] -> [Maybe Durations])
-> [Durations]
-> [(String, Maybe Durations)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Durations -> Maybe Durations) -> [Durations] -> [Maybe Durations]
forall a b. (a -> b) -> [a] -> [b]
map Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([Durations] -> [(String, Maybe Durations)])
-> [Durations] -> [(String, Maybe Durations)]
forall a b. (a -> b) -> a -> b
$
          [[(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes,
            [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes,
              [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes,
                [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes,
                  [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes,
                    [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes,
                      [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes, [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes,
                        [(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(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, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes]) String
xs
 | Bool
otherwise = Maybe Durations
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 -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) [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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0,Int
1,Int
3,Int
5] then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
i,Float
_) -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int
0,Int
1,Int
3,Int
5]) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
6 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes) else Maybe Durations
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0,Int
2,Int
3,Int
5] then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
i,Float
_) -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int
0,Int
2,Int
3,Int
5]) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
6 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes) else Maybe Durations
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0,Int
2,Int
4,Int
5] then Durations -> Maybe Durations
forall a. a -> Maybe a
Just ([(Int, Float)] -> Durations
forall a b. [(a, b)] -> Array Int b
h4 ([(Int, Float)] -> Durations)
-> (Durations -> [(Int, Float)]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
i,Float
_) -> Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int
0,Int
2,Int
4,Int
5]) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
6 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes) else Maybe Durations
forall a. Maybe a
Nothing
      String
_   -> Maybe Durations
forall a. Maybe a
Nothing
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) [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 Durations
-> [(String, Maybe Durations)] -> String -> Maybe Durations
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Maybe Durations
forall a. Maybe a
Nothing ([String] -> [Maybe Durations] -> [(String, Maybe Durations)]
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 Durations] -> [(String, Maybe Durations)])
-> [Maybe Durations] -> [(String, Maybe Durations)]
forall a b. (a -> b) -> a -> b
$ ([Int] -> Maybe Durations) -> [[Int]] -> [Maybe Durations]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int -> [Int] -> Maybe Durations
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 Durations
forall a. Maybe a
Nothing

h3 :: Int -> Int -> Int -> [Int] -> Maybe (Array Int Float)
h3 :: Int -> Int -> Int -> [Int] -> Maybe Durations
h3 Int
nT Int
n2 Int
nL [Int]
zs
 | Int
nT Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nL = Durations -> Maybe Durations
forall a. a -> Maybe a
Just ((\[Float]
rs -> (Int, Int) -> [Float] -> Durations
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Float]
rs) ([Float] -> Durations)
-> (Durations -> [Float]) -> Durations -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Float) -> [(Int, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Float) -> Float
forall a b. (a, b) -> b
snd ([(Int, Float)] -> [Float])
-> (Durations -> [(Int, Float)]) -> Durations -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Float) -> Bool) -> [(Int, Float)] -> [(Int, Float)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
i, Float
_) -> Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int]
zs) ([(Int, Float)] -> [(Int, Float)])
-> (Durations -> [(Int, Float)]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Float] -> [(Int, Float)])
-> (Durations -> [Float]) -> Durations -> [(Int, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Durations -> [Float]
forall a (t :: * -> *).
(Eq a, Foldable t) =>
Int -> Int -> t a -> [a]
sliceToList Int
nL Int
n2 (Durations -> Durations) -> Durations -> Durations
forall a b. (a -> b) -> a -> b
$ Durations
notes)
 | Bool
otherwise = Maybe Durations
forall a. Maybe a
Nothing

-- | Partial function. The list must be not empty though it is not checked.
h4 :: [(a,b)] -> Array Int b
h4 :: [(a, b)] -> Array Int b
h4 = (\[b]
rs -> (Int, Int) -> [b] -> Array Int b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [b]
rs) ([b] -> Array Int b)
-> ([(a, b)] -> [b]) -> [(a, b)] -> Array Int b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd
{-# INLINE h4 #-}

-- | 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 :: [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. The list argument must be sorted in the ascending order.
toneD :: Int -> Int -> Int -> [Int] -> Bool
toneD :: Int -> Int -> Int -> [Int] -> Bool
toneD Int
i Int
nL Int
nT [Int]
zs = Bool -> [(Int, Bool)] -> Int -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
True ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
zs ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
12 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
False) ((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)

-- | 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. The list argument must be sorted in the ascending order.
toneE :: Int -> Int -> Int -> [Int] -> Bool
toneE :: Int -> Int -> Int -> [Int] -> Bool
toneE Int
i Int
nL Int
nT [Int]
zs = 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]
zs ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
12 (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) ((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)

-- | 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).
-- Partial function.
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 =
    let !ys :: [Float]
ys = (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> (Int -> Float) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
log (Float -> Float) -> (Int -> Float) -> Int -> 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) (Float -> Float) -> (Int -> Float) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
i ->
           Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
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))))
             [Int
0..Params -> Int
lengthP Params
params Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] in Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt (Maybe Durations -> Durations
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Durations -> Durations)
-> (Params -> Maybe Durations) -> Params -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe Durations
filterInParams (Params -> Durations) -> Params -> Durations
forall a b. (a -> b) -> a -> b
$ Params
params) (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> ([Float] -> Maybe Int) -> [Float] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> [Float] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
ys) ([Float] -> Int) -> [Float] -> Int
forall a b. (a -> b) -> a -> b
$ [Float]
ys)

-- | Application of the 'liftInParams' to a list.
-- Partial function.
liftInParamsV :: Params -> [Float] -> [Float]
liftInParamsV :: Params -> [Float] -> [Float]
liftInParamsV Params
params = (Float -> Bool) -> [Float] -> [Float]
forall a. (a -> Bool) -> [a] -> [a]
filter (Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
11440.0) ([Float] -> [Float]) -> ([Float] -> [Float]) -> [Float] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\Float
x -> Float -> Params -> Float
liftInParams Float
x Params
params)

-- | Gets a length of the 'Array' 'Int' 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
. (Durations -> Int) -> Maybe Durations -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Durations -> Int
forall i e. Array i e -> Int
numElements (Maybe Durations -> Maybe Int)
-> (Params -> Maybe Durations) -> Params -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe Durations
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
. (Durations -> Bool) -> Maybe Durations -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float
note Float -> Durations -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem`) (Maybe Durations -> Maybe Bool)
-> (Params -> Maybe Durations) -> Params -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe Durations
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
. (Durations -> Bool) -> Maybe Durations -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float -> Float
closestNote Float
note Float -> Durations -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem`) (Maybe Durations -> Maybe Bool)
-> (Params -> Maybe Durations) -> Params -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe Durations
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 Durations -> String
forall a. Show a => a -> String
show (Maybe Durations -> String)
-> (Params -> Maybe Durations) -> Params -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Maybe Durations
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 Durations -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe Durations
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 Durations -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe Durations
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 Durations -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe Durations
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 Durations -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe Durations
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 Durations -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe Durations
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 Durations -> Bool
forall a. Maybe a -> Bool
isJust (Params -> Maybe Durations
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 list 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 :: [Float]
vFreqs = ((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
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 :: [Float]
vD = ((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
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 :: [OvertonesO]
v2 = (Float -> OvertonesO) -> [Float] -> [OvertonesO]
forall a b. (a -> b) -> [a] -> [b]
map Float -> OvertonesO
f [Float]
vFreqs
      vS :: [String]
vS = (Float -> String) -> [Float] -> [String]
forall a b. (a -> b) -> [a] -> [b]
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
"") [Float]
vD
      !l3 :: Int
l3 = [OvertonesO] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OvertonesO]
v2
      h42 :: a -> ((a, b), OvertonesO, a, String) -> IO ()
h42 a
j ((a, b)
x,OvertonesO
v3,a
y,String
ts)
        | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0.0 = do
           (ExitCode
_,String
_,String
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
""
           String -> IO ()
forall a. Show a => a -> IO ()
print String
herr
           OvertonesO -> Int -> String -> Durations -> IO ()
partialTest_k1G OvertonesO
v3 Int
0 String
ts ((\[Float]
rs -> (Int, Int) -> [Float] -> Durations
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
l3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Float]
rs) ([Float] -> Durations) -> (Float -> [Float]) -> Float -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float -> [Float]
forall a. Int -> a -> [a]
replicate Int
l3 (Float -> Durations) -> Float -> Durations
forall a b. (a -> b) -> a -> b
$ Float
0.0)
           IO ()
mixTest
           String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes (OvertonesO -> Int
forall a. [a] -> Int
numVZeroesPre OvertonesO
v) (a -> String
forall a. Show a => a -> String
show a
j) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav"
        | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.0 = do
           (ExitCode
_,String
_,String
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
""
           String -> IO ()
putStr String
herr
           String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes (OvertonesO -> Int
forall a. [a] -> Int
numVZeroesPre OvertonesO
v) (a -> String
forall a. Show a => a -> String
show a
j) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav"
        | Bool
otherwise = String -> IO ()
putStrLn String
"Zero length of the sound! "
  ((Integer, ((Float, Float), OvertonesO, Float, String)) -> IO ())
-> [(Integer, ((Float, Float), OvertonesO, Float, String))]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
j, ((Float, Float), OvertonesO, Float, String)
zz) -> Integer -> ((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 Integer
j ((Float, Float), OvertonesO, Float, String)
zz) ([(Integer, ((Float, Float), OvertonesO, Float, String))] -> IO ())
-> ([String]
    -> [(Integer, ((Float, Float), OvertonesO, Float, String))])
-> [String]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer]
-> [((Float, Float), OvertonesO, Float, String)]
-> [(Integer, ((Float, Float), OvertonesO, Float, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([((Float, Float), OvertonesO, Float, String)]
 -> [(Integer, ((Float, Float), OvertonesO, Float, String))])
-> ([String] -> [((Float, Float), OvertonesO, Float, String)])
-> [String]
-> [(Integer, ((Float, Float), OvertonesO, Float, String))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO
-> [OvertonesO]
-> [Float]
-> [String]
-> [((Float, Float), OvertonesO, Float, String)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 OvertonesO
v [OvertonesO]
v2 [Float]
vD ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
vS

{-| A variant of the 'overMeloPar2G' with the first argument controlling the sound quality parameters. For more information,
please, refer to 'soxBasicParams' documentation. -}
overMeloPar2G :: String -> (Float -> OvertonesO) -> (Float -> Float) -> Params -> Float -> Float -> Float -> IO ()
overMeloPar2G :: String
-> (Float -> OvertonesO)
-> (Float -> Float)
-> Params
-> Float
-> Float
-> Float
-> IO ()
overMeloPar2G String
ys 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 :: [Float]
vFreqs = ((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
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 :: [Float]
vD = ((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
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 :: [OvertonesO]
v2 = (Float -> OvertonesO) -> [Float] -> [OvertonesO]
forall a b. (a -> b) -> [a] -> [b]
map Float -> OvertonesO
f [Float]
vFreqs
      vS :: [String]
vS = (Float -> String) -> [Float] -> [String]
forall a b. (a -> b) -> [a] -> [b]
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
"") [Float]
vD
      !l3 :: Int
l3 = [OvertonesO] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OvertonesO]
v2
      h42 :: a -> ((a, b), OvertonesO, a, String) -> IO ()
h42 a
j ((a, b)
x,OvertonesO
v3,a
y,String
ts)
        | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0.0 = do
           (ExitCode
_,String
_,String
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")) ((if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys then [String] -> [String]
forall a. a -> a
id else String -> [String] -> [String]
soxBasicParams String
ys) [String
"-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
""
           String -> IO ()
forall a. Show a => a -> IO ()
print String
herr
           OvertonesO -> Int -> String -> Durations -> String -> IO ()
partialTest_k2G OvertonesO
v3 Int
0 String
ts ((\[Float]
rs -> (Int, Int) -> [Float] -> Durations
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
l3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Float]
rs) ([Float] -> Durations) -> (Float -> [Float]) -> Float -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float -> [Float]
forall a. Int -> a -> [a]
replicate Int
l3 (Float -> Durations) -> Float -> Durations
forall a b. (a -> b) -> a -> b
$ Float
0.0) String
ys
           String -> IO ()
mixTest2G String
ys
           Bool
wavF <- String -> IO Bool
doesFileExist String
"result.wav"
           if Bool
wavF then String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes (OvertonesO -> Int
forall a. [a] -> Int
numVZeroesPre OvertonesO
v) (a -> String
forall a. Show a => a -> String
show a
j) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav"
           else do
            Bool
flacF <- String -> IO Bool
doesFileExist String
"result.flac"
            if Bool
flacF then String -> String -> IO ()
renameFile String
"result.flac" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes (OvertonesO -> Int
forall a. [a] -> Int
numVZeroesPre OvertonesO
v) (a -> String
forall a. Show a => a -> String
show a
j) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".flac"
            else String -> IO ()
putStrLn String
"Composition.Sound.Functional.Params.overMeloPar2G: No \"result*\" file is present in the directory. "
        | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.0 = do
           (ExitCode
_,String
_,String
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")) ((if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys then [String] -> [String]
forall a. a -> a
id else String -> [String] -> [String]
soxBasicParams String
ys) [String
"-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
""
           String -> IO ()
putStr String
herr
           Bool
wavF <- String -> IO Bool
doesFileExist String
"result.wav"
           if Bool
wavF then String -> String -> IO ()
renameFile String
"result.wav" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes (OvertonesO -> Int
forall a. [a] -> Int
numVZeroesPre OvertonesO
v) (a -> String
forall a. Show a => a -> String
show a
j) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".wav"
           else do
            Bool
flacF <- String -> IO Bool
doesFileExist String
"result.flac"
            if Bool
flacF then String -> String -> IO ()
renameFile String
"result.flac" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"result" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes (OvertonesO -> Int
forall a. [a] -> Int
numVZeroesPre OvertonesO
v) (a -> String
forall a. Show a => a -> String
show a
j) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".flac"
            else String -> IO ()
putStrLn String
"Composition.Sound.Functional.Params.overMeloPar2G: No \"result*\" file is present in the directory. "
        | Bool
otherwise = String -> IO ()
putStrLn String
"Zero length of the sound! "
  ((Integer, ((Float, Float), OvertonesO, Float, String)) -> IO ())
-> [(Integer, ((Float, Float), OvertonesO, Float, String))]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
j, ((Float, Float), OvertonesO, Float, String)
zz) -> Integer -> ((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 Integer
j ((Float, Float), OvertonesO, Float, String)
zz) ([(Integer, ((Float, Float), OvertonesO, Float, String))] -> IO ())
-> ([String]
    -> [(Integer, ((Float, Float), OvertonesO, Float, String))])
-> [String]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer]
-> [((Float, Float), OvertonesO, Float, String)]
-> [(Integer, ((Float, Float), OvertonesO, Float, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([((Float, Float), OvertonesO, Float, String)]
 -> [(Integer, ((Float, Float), OvertonesO, Float, String))])
-> ([String] -> [((Float, Float), OvertonesO, Float, String)])
-> [String]
-> [(Integer, ((Float, Float), OvertonesO, Float, String))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO
-> [OvertonesO]
-> [Float]
-> [String]
-> [((Float, Float), OvertonesO, Float, String)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 OvertonesO
v [OvertonesO]
v2 [Float]
vD ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [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, 'convertToProperUkrainianS') 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.).
-- Partial function.
str2DurationsDef :: Int -> String -> Float -> Durations
str2DurationsDef :: Int -> String -> Float -> Durations
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
      !l :: Int
l = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        in (Int -> Float) -> Array Int Int -> Durations
forall a b i. (a -> b) -> Array i a -> Array i b
amap (\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 (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. [a] -> a
head [Int]
t)) (Array Int Int -> Durations)
-> ([Int] -> Array Int Int) -> [Int] -> Durations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) ([Int] -> Durations) -> [Int] -> Durations
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
  Int
upp <- String -> IO Int
upperBnd String
file
  Float
ampL2 <- ((String, Bool) -> Float) -> IO (String, Bool) -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\String
zz -> String -> Float
forall a. Read a => String -> a
read String
zz::Float) (String -> Float)
-> ((String, Bool) -> String) -> (String, Bool) -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> String
forall a b. (a, b) -> a
fst) (String -> (Int, Int) -> IO (String, Bool)
selMaxAbs String
file (Int
0,Int
upp))
  if Float -> Float
forall a. Num a => a -> a
abs Float
ampL2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float -> Float
forall a. Num a => a -> a
abs Float
limV then String -> IO ()
putStr String
"" else Float -> String -> IO ()
apply6Gf Float
vol String
file

-- | Apply volume adjustment to the sound file. It must not be silent. Otherwise, it leads to likely noise sounding or errors.
-- The code is adapted from the MMSyn7l module from the @mmsyn7l@ package.
apply6Gf :: Float -> FilePath -> IO ()
apply6Gf :: Float -> String -> IO ()
apply6Gf Float
vol String
file = do
  (ExitCode
code,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ([String
file,String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
efw2 String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [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
""]) String
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> String -> String -> IO ()
renameFile (String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
efw2 String
file) String
file
    ExitCode
_ -> do
       String -> IO ()
removeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"effects" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
efw2 String
file
       String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"MMSyn7l.soxE \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" has not been successful. The file has not been changed at all. "

-- | 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]
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. [a] -> [a]
cycle ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> (String -> [[Int]]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[UZPP Char PhoneticType]] -> [Int])
-> [[[UZPP Char PhoneticType]]] -> [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([UZPP Char PhoneticType] -> Int)
-> [[UZPP Char PhoneticType]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([UZPP Char PhoneticType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)) ([[[UZPP Char PhoneticType]]] -> [[Int]])
-> (String -> [[[UZPP Char PhoneticType]]]) -> String -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP Char PhoneticType]]]
createSyllablesUkrS (String -> [Int]) -> String -> [Int]
forall a b. (a -> b) -> a -> b
$ String
xs
      y :: Int
y  = [Int] -> Int
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

-- | 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 -> Array Int Float -> String -> IO ()
overSoXSynth2FDN_Sf32G :: (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> String
-> Durations
-> String
-> IO ()
overSoXSynth2FDN_Sf32G Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j String
zs Durations
vdB String
ys
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
convertToProperUkrainianS (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
zs = (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG Float -> OvertonesO
f Float
x
 | Bool
otherwise = do
    let l0 :: Int
l0    = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
zs
    [Float -> Float]
-> [Float]
-> [Int]
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Durations
-> String
-> IO ()
soundGenF32G [\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 Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
0),\Float
x2 -> Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe (Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
0)
     (Int -> Float -> Maybe Float
dNote (Array Int Int -> Int -> Int
forall i e. Array i e -> Int -> e
unsafeAt (String -> Array Int 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 Durations -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Durations
notes Int
0)))]
       (Int -> Float -> [Float]
forall a. Int -> a -> [a]
replicate Int
2 Float
x) [Int
1,Array Int Int -> Int -> Int
forall i e. Array i e -> Int -> e
unsafeAt (String -> Array Int 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 Durations
vdB String
ys
    if String -> 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 -> Array Int Int
intervalsFromString = Array Int Int -> String -> Array Int Int
vStrToVIntG Array Int Int
defInt (String -> Array Int Int) -> ShowS -> String -> Array Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
convertToProperUkrainianS

-- | Generatlized version of the 'vStrToVInt' with a possibility to specify your own 'Intervals'.
vStrToVIntG :: Intervals -> String -> Intervals
vStrToVIntG :: Array Int Int -> String -> Array Int Int
vStrToVIntG Array Int Int
v String
xs = (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) ([Int] -> Array Int Int)
-> (String -> [Int]) -> String -> Array Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Array Int Int -> Char -> Int
strToIntG Array Int Int
v) (String -> Array Int Int) -> String -> Array Int Int
forall a b. (a -> b) -> a -> b
$ String
xs
 where l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Default values for 'strToInt'. All the intervals are not greater than one full octave.
defInt :: Intervals
defInt :: Array Int Int
defInt = (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
28) [Int
5,Int
3,Int
7,Int
11,Int
1,Int
12,Int
4,Int
11,Int
4,Int
12,Int
2,Int
9,Int
3,Int
12,Int
5,Int
10,Int
7,Int
7,Int
7,Int
12,Int
10,Int
7,Int
10,Int
2,Int
12,Int
7,Int
2,Int
12,Int
8]
{-# INLINE defInt #-}

-- | Generatlized version of the 'strToInt' with a possibility to specify your own 'Intervals'.
strToIntG :: Intervals -> Char -> Int
strToIntG :: Array Int Int -> Char -> Int
strToIntG Array Int Int
v =
  Int -> [(Char, Int)] -> Char -> Int
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Int
0 (String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"ABCEFabcdefghijklmnoprstuvxyz" ([Int] -> [(Char, Int)])
-> (Array Int Int -> [Int]) -> Array Int Int -> [(Char, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int Int -> [Int]
forall i e. Array i e -> [e]
elems (Array Int Int -> [(Char, Int)]) -> Array Int Int -> [(Char, Int)]
forall a b. (a -> b) -> a -> b
$ Array Int Int
v)
{-# INLINE strToIntG #-}

-- | Generates a melodic line (a somewhat complex changing sound) with a possibility to specify sound quality using the 'String' argument. For more information,
-- please, refer to 'soxBasicParams'.
soundGenF32G :: [Float -> Float] -> [Float] -> [Int] -> (Float -> OvertonesO) -> (Float, Float, Float) -> Int ->
  Array Int Float -> String -> IO ()
soundGenF32G :: [Float -> Float]
-> [Float]
-> [Int]
-> (Float -> OvertonesO)
-> (Float, Float, Float)
-> Int
-> Durations
-> String
-> IO ()
soundGenF32G [Float -> Float]
vf [Float]
vd [Int]
vi Float -> OvertonesO
f (Float
x, Float
y, Float
t0) Int
j Durations
vdB String
ys = do
  let vD :: [Maybe Float]
vD = [Float -> Float] -> [Float] -> [Int] -> [Maybe Float]
helpF1 [Float -> Float]
vf [Float]
vd [Int]
vi
      vDz :: [Float]
vDz = (Maybe Float -> Maybe Float) -> [Maybe Float] -> [Float]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Maybe Float -> Maybe Float
forall a. a -> a
id [Maybe Float]
vD -- The previous one without Nothings and Justs
      vNotes :: [OvertonesO]
vNotes = (Float -> OvertonesO) -> Float -> [Maybe Float] -> [OvertonesO]
doubleVecFromVecOfFloat Float -> OvertonesO
f Float
t0 ([Maybe Float] -> [OvertonesO])
-> ([Float] -> [Maybe Float]) -> [Float] -> [OvertonesO]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Maybe Float) -> [Float] -> [Maybe Float]
forall a b. (a -> b) -> [a] -> [b]
map Float -> Maybe Float
forall a. a -> Maybe a
Just ([Float] -> [OvertonesO]) -> [Float] -> [OvertonesO]
forall a b. (a -> b) -> a -> b
$ [Float]
vDz
      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, OvertonesO, Float) -> IO ())
-> [(Int, Float, OvertonesO, Float)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
i, Float
w, OvertonesO
u, Float
vv) -> do
    (ExitCode, String, String)
_ <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe String
showE String
"sox")) ((if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys then [String] -> [String]
forall a. a -> a
id else String -> [String] -> [String]
soxBasicParams String
ys) (((\[String]
wwws -> [String] -> Float -> [String]
adjust_dbVol [String]
wwws Float
vv)) [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 Float
w String
"",String
"vol", if Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.0 then String
"1.0" else String
"0"])) String
""
    OvertonesO -> Int -> String -> Durations -> String -> IO ()
partialTest_k2G OvertonesO
u Int
i String
ts Durations
vdB String
ys) ([(Int, Float, OvertonesO, Float)] -> IO ())
-> (Durations -> [(Int, Float, OvertonesO, Float)])
-> Durations
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> [Float]
-> [OvertonesO]
-> [Float]
-> [(Int, Float, OvertonesO, Float)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 [Int
0..] [Float]
vDz [OvertonesO]
vNotes ([Float] -> [(Int, Float, OvertonesO, Float)])
-> (Durations -> [Float])
-> Durations
-> [(Int, Float, OvertonesO, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Durations -> [Float]
forall i e. Array i e -> [e]
elems (Durations -> IO ()) -> Durations -> IO ()
forall a b. (a -> b) -> a -> b
$ Durations
vdB

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 :: [Float -> Float] -> [Float] -> [Int] -> [Maybe Float]
helpF1 :: [Float -> Float] -> [Float] -> [Int] -> [Maybe Float]
helpF1 [Float -> Float]
vf [Float]
vd =
  ((Float -> Float, Float, Int) -> Maybe Float)
-> [(Float -> Float, Float, Int)] -> [Maybe Float]
forall a b. (a -> b) -> [a] -> [b]
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) ([(Float -> Float, Float, Int)] -> [Maybe Float])
-> ([Int] -> [(Float -> Float, Float, Int)])
-> [Int]
-> [Maybe Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float -> Float]
-> [Float] -> [Int] -> [(Float -> Float, Float, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Float -> Float]
vf [Float]
vd

-- | Generates a list of 'OvertonesO' that represents the melodic line.
doubleVecFromVecOfFloat :: (Float -> OvertonesO) -> Float -> [Maybe Float] -> [OvertonesO]
doubleVecFromVecOfFloat :: (Float -> OvertonesO) -> Float -> [Maybe Float] -> [OvertonesO]
doubleVecFromVecOfFloat Float -> OvertonesO
f Float
t0 =
  (Maybe Float -> OvertonesO) -> [Maybe Float] -> [OvertonesO]
forall a b. (a -> b) -> [a] -> [b]
map (\Maybe Float
note1 -> if Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Float
note1 then [] else ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Float
_,!Float
z) -> Float -> Float
forall a. Num a => a -> a
abs Float
z Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
t0) (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)