-- |
-- Module      :  Composition.Sound.Functional.Basics
-- Copyright   :  (c) OleksandrZhabenko 2020
-- 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. Is more complicated than
-- dobutokO2 and uses its functionality.

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

module Composition.Sound.Functional.Basics (
  -- * Type synonyms with different semantics
  SoundsO
  , OvertonesO
  , NotePairs
  -- * Work with notes (general)
  , notes
  , neighbourNotes
  , closestNote
  , pureQuintNote 
  , overTones
  , overTonesALaClarinet
  -- * Work with overtones
  , overSoXSynth
  , overSoXSynthALaClarinet
  -- ** Generalized function
  , overSoXSynthG
  -- * Work with enky (extension to octaves functionality)
  , nkyT
  , whichOctave
  , whichOctaveG
  , whichEnka 
  , enkuUp 
  , enkuDown 
  , liftInEnkuV
  , liftInEnku
  -- ** Work with octaves
  , octavesT
  -- * Combining intermediate files
  , mixTest
  , mixTest2
  -- * Working with files
  , freqsFromFile
  , endFromResult
  -- * Use additional function and Ukrainian texts and generates melody
  , dNote
  -- ** 2G generalized auxiliary functions
  , mixTest2G
  , mixTest22G
  , endFromResult2G
  -- ** Auxiliary functions
  , partialTest_k1G
  , partialTest_k2G
  , prependZeroes 
  , nOfZeroesLog 
  , numVZeroesPre
  , duration1000
  , adjust_dbVol
) where

import GHC.List (iterate')
import CaseBi.Arr (getBFstLSorted')
import Data.Char (isDigit)
import System.Exit (ExitCode( ExitSuccess ))
import Numeric
import Data.List (isPrefixOf,sort)
import Data.Maybe (fromJust,isJust,fromMaybe,mapMaybe)
import qualified Data.Foldable as F (find)
import GHC.Arr
import Sound.SoXBasics (durationA)
import System.Process
import EndOfExe
import System.Directory
import Composition.Sound.IntermediateF

-- | Is used to represent a sequence of intervals, each note being a 'Float' value (its frequency in Hz).
type SoundsO = Array Int (Float, Float)

-- | Is used to represent a set of overtones for the single sound, the first 'Float' value is a frequency and the second one -- an amplitude.
type OvertonesO = [(Float, Float)]

-- | Is used to represent a set of pairs of notes for each element of which the 'Float' values (notes frequencies in Hz) are somewhat
-- musically connected one with another..
type NotePairs = Array Int (Float, Float)

-- | Gets 'Int' frequencies from the given 'FilePath' using SoX. The frequencies are \"rough\" according to the SoX documentation and
-- the duration is too small so they can be definitely other than expected ones. Is used as a source of variable numbers (somewhat close each to another
-- in their order but not neccessarily). .
freqsFromFile :: FilePath -> Int -> IO [Int]
freqsFromFile :: FilePath -> Int -> IO [Int]
freqsFromFile FilePath
file Int
n = (Int -> IO Int) -> [Int] -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
k -> do {
    (ExitCode
_, FilePath
_, FilePath
herr) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
file, FilePath
"-n", FilePath
"trim", Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.001) FilePath
"",
      FilePath
"0.001", FilePath
"stat"] FilePath
""
    ; let line0s :: [FilePath]
line0s = FilePath -> [FilePath]
lines FilePath
herr
          noteN0 :: FilePath
noteN0 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit ShowS -> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) ShowS -> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
13 ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
14 ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
line0s
    ; if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
noteN0 then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
11440::Int)
      else let noteN1 :: Int
noteN1  = FilePath -> Int
forall a. Read a => FilePath -> a
read ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit ShowS -> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) ShowS -> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
13 ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
14 ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
line0s)::Int in Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
noteN1 }) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

-- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work
-- on them properly. Afterwards, the function deletes these combined files.
mixTest :: IO ()
mixTest :: IO ()
mixTest = do
  [FilePath]
paths0 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let paths :: [FilePath]
paths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"test") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
paths0
  (ExitCode, FilePath, FilePath)
_ <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath
"--combine", FilePath
"mix"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"result.wav",FilePath
"vol",FilePath
"0.3"]) FilePath
""
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
paths

-- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to
-- 'soxBasicParams'.
mixTest2G :: String -> IO ()
mixTest2G :: FilePath -> IO ()
mixTest2G FilePath
ys = do
  [FilePath]
paths0 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let paths :: [FilePath]
paths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"test") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
paths0
  (ExitCode, FilePath, FilePath)
_ <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath
"--combine", FilePath
"mix"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys [FilePath
"",FilePath
"result.wav",FilePath
"vol",FilePath
"0.3"]) FilePath
""
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
paths

-- | Combines (mixes) all \"test\*" files in the given directory. The files should be similar in parameters and must be sound files for SoX to work
-- on them properly. Afterwards, the function deletes these combined files. The name of the resulting file depends on the first two command line
-- arguments so that it is easy to produce unique names for the consequent call for the function.
mixTest2 :: Int -> Int -> IO ()
mixTest2 :: Int -> Int -> IO ()
mixTest2 Int
zeroN Int
j = do
  [FilePath]
paths0 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let paths :: [FilePath]
paths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"test") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
paths0
  (ExitCode, FilePath, FilePath)
_ <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath
"--combine", FilePath
"mix"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"result" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav",
    FilePath
"vol",FilePath
"0.3"]) FilePath
""
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
paths

-- | Similar to 'mixTest', but allows to change the sound quality parameters for the resulting file. For more information, please, refer to
-- 'soxBasicParams'. The name of the resulting file depends on the first two command line
-- arguments so that it is easy to produce unique names for the consequent call for the function.
mixTest22G :: Int -> Int -> String -> IO ()
mixTest22G :: Int -> Int -> FilePath -> IO ()
mixTest22G Int
zeroN Int
j FilePath
ys = do
  [FilePath]
paths0 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let paths :: [FilePath]
paths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"test") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
paths0
  (ExitCode, FilePath, FilePath)
_ <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath
"--combine", FilePath
"mix"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys [FilePath
"",FilePath
"result" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
".wav",FilePath
"vol",FilePath
"0.3"]) FilePath
""
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
paths  

-- | Gets an \"end.wav\" file from the intermediate \"result\*.wav\" files in the current directory. If it is not successful, produces the notification
-- message and exits without error. If you would like to create the file if there are too many intermediate ones, please, run
-- \"dobutokO2 8\" or \"dobutokO2 80\" in the current directory.
endFromResult :: IO ()
endFromResult :: IO ()
endFromResult = do
  [FilePath]
path2s <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let paths3 :: [FilePath]
paths3 = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"result") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
path2s
  (ExitCode
code,FilePath
_,FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath]
paths3 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"end.wav"]) FilePath
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> FilePath -> IO ()
putStrLn FilePath
"The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. "
    ExitCode
_           -> do
      Bool
exi <- FilePath -> IO Bool
doesFileExist FilePath
"end.wav"
      if Bool
exi then FilePath -> IO ()
removeFile FilePath
"end.wav"
      else FilePath -> IO ()
putStr FilePath
"Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        FilePath -> IO ()
putStrLn FilePath
"Use them manually as needed."

-- | Similar to 'endFromResult', but uses additional 'String' argument to change sound quality parameters. For more information, please, refer to
-- 'soxBasicParams'.
endFromResult2G :: String -> IO ()
endFromResult2G :: FilePath -> IO ()
endFromResult2G FilePath
ys = do
  [FilePath]
path2s <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
  let paths3 :: [FilePath]
paths3 = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"result") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
path2s
  (ExitCode
code,FilePath
_,FilePath
_) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath]
paths3 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys [FilePath
"",FilePath
"end.wav"]) FilePath
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"The final file \"end." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 FilePath
ys FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"f" then FilePath
"flac" else FilePath
"wav" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\" was successfully created. You can now manually change or delete \"result*\" files in the directory. "
    ExitCode
_           -> do
      Bool
exi <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"end." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 FilePath
ys FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"f" then FilePath
"flac" else FilePath
"wav"
      if Bool
exi then FilePath -> IO ()
removeFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"end." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 FilePath
ys FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"f" then FilePath
"flac" else FilePath
"wav"
      else FilePath -> IO ()
putStr FilePath
"Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        FilePath -> IO ()
putStrLn FilePath
"Use them manually as needed."            

-- | Generates part of the \"test\*\" files with the additional volume adjustment in dB given by 'Array' 'Int' 'Float'.
partialTest_k1G :: OvertonesO -> Int -> String -> Array Int Float -> IO ()
partialTest_k1G :: OvertonesO -> Int -> FilePath -> Array Int Float -> IO ()
partialTest_k1G OvertonesO
ks Int
k FilePath
ts Array Int Float
arr2 = OvertonesO
-> Int -> FilePath -> Array Int Float -> FilePath -> IO ()
partialTest_k2G OvertonesO
ks Int
k FilePath
ts Array Int Float
arr2 []

-- | Generalized version of the 'partialTest_k1G' with a possibility to change sound quality parameters using the additional second 'String' argument.
-- For more information, please, refer to 'soxBasicParams'.
partialTest_k2G :: OvertonesO -> Int -> String -> Array Int Float -> String -> IO ()
partialTest_k2G :: OvertonesO
-> Int -> FilePath -> Array Int Float -> FilePath -> IO ()
partialTest_k2G OvertonesO
ks Int
k FilePath
ts Array Int Float
arr2 FilePath
ys =
  let zeroN :: Int
zeroN = OvertonesO -> Int
forall a. [a] -> Int
numVZeroesPre OvertonesO
ks in ((Int, (Float, Float)) -> IO ())
-> [(Int, (Float, Float))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
i, (Float
noteN, !Float
amplN)) -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
50 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then do
      (ExitCode, FilePath, FilePath)
_ <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) (FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys ([FilePath] -> Float -> [FilePath]
adjust_dbVol [FilePath
"-r22050", FilePath
"-n", FilePath
"test" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav",
         FilePath
"synth", FilePath
ts,FilePath
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
noteN) FilePath
"", FilePath
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN FilePath
""]
            (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
arr2 Int
i))) FilePath
""
      [FilePath]
path1s <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
      let path2s :: [FilePath]
path2s = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"test" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
path1s
      (ExitCode
code,FilePath
_,FilePath
herr0) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ([FilePath
"--combine", FilePath
"mix"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
path2s [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys [FilePath
"",FilePath
"test-" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        Int -> ShowS
prependZeroes Int
zeroN (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
50)) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav"]) FilePath
""
      case ExitCode
code of
        ExitCode
ExitSuccess -> (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
path2s
        ExitCode
_           -> do
          Bool
exi <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"test-" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
50)) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 FilePath
ys FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"f" then FilePath
".flac" else FilePath
".wav"
          if Bool
exi then FilePath -> IO ()
putStrLn (FilePath
herr0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
removeFile (FilePath
"test-" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
50)) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 FilePath
ys FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"f" then FilePath
".flac" else FilePath
".wav")
          else FilePath -> IO ()
putStrLn FilePath
herr0
    else FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) ((if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
ys then [FilePath] -> [FilePath]
forall a. a -> a
id else FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys) (((\[FilePath]
wwws -> [FilePath] -> Float -> [FilePath]
adjust_dbVol [FilePath]
wwws (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
arr2 Int
i))) [FilePath
"-r22050", FilePath
"-n", FilePath
"test" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav",
       FilePath
"synth", FilePath
ts,FilePath
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
noteN) FilePath
"", FilePath
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN FilePath
""])) FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
putStr FilePath
"") ([(Int, (Float, Float))] -> IO ())
-> (OvertonesO -> [(Int, (Float, Float))]) -> OvertonesO -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> OvertonesO -> [(Int, (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (OvertonesO -> IO ()) -> OvertonesO -> IO ()
forall a b. (a -> b) -> a -> b
$ OvertonesO
ks

-- | Auxiliary function to get from a sound file specified a duration parameter @n@ that can be used further.
duration1000 :: FilePath -> IO Int
duration1000 :: FilePath -> IO Int
duration1000 FilePath
file = (Float -> Int) -> IO Float -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Float
t -> Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0.001)) (IO Float -> IO Int)
-> (FilePath -> IO Float) -> FilePath -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Float
durationA (FilePath -> IO Int) -> FilePath -> IO Int
forall a b. (a -> b) -> a -> b
$ FilePath
file

-- | Function to get from the number of semi-tones and a note a 'Maybe' note for the second lower note in the interval if any. If there is
-- no need to obtain such a note, then the result is 'Nothing'.
dNote :: Int -> Float -> Maybe Float
dNote :: Int -> Float -> Maybe Float
dNote Int
n Float
note
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
note (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT Bool -> Bool -> Bool
|| Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
note (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = Maybe Float
forall a. Maybe a
Nothing
  | Bool
otherwise = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float
note Float -> Float -> Float
forall a. Fractional 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
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12))

-- | 'Array' of musical notes in Hz.
notes :: Array Int Float
-- notes V.! 57 = 440.0   -- A4 in Hz
notes :: Array Int Float
notes = (Int, Int) -> [Float] -> Array Int Float
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
107) ([Float] -> Array Int Float)
-> ([Integer] -> [Float]) -> [Integer] -> Array Int Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Float) -> [Integer] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
t ->  Float
440 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
2 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
57) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12)) ([Integer] -> Array Int Float) -> [Integer] -> Array Int Float
forall a b. (a -> b) -> a -> b
$ [Integer
0..Integer
107]

-- | Function returns either the nearest two musical notes if frequency is higher than one for C0 and lower than one for B8
-- or the nearest note duplicated in a tuple.
neighbourNotes :: Float -> (Int,Int) -> (Float, Float)
neighbourNotes :: Float -> (Int, Int) -> (Float, Float)
neighbourNotes Float
x (!Int
ll,!Int
mm)
  | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
ll = (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
ll, Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
ll)
  | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
mm = (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
mm, Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
mm)
  | Int
mm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = if Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes ((Int
mm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ll) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)
      then Float -> (Int, Int) -> (Float, Float)
neighbourNotes Float
x (Int
ll, (Int
mm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ll) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)
      else Float -> (Int, Int) -> (Float, Float)
neighbourNotes Float
x ((Int
mm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ll) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2, Int
mm)
  | Bool
otherwise = (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
ll, Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
mm)

-- | Returns the closest note to the given frequency in Hz.  
closestNote :: Float -> Float
closestNote :: Float -> Float
closestNote Float
x
 | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.0 =
    let (Float
x0, Float
x2) = Float -> (Int, Int) -> (Float, Float)
neighbourNotes Float
x (Int
0,Int
107)
        r0 :: Float
r0       = Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x0
        r2 :: Float
r2       = Float
x2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x in 
    if Float
r2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
r0 then Float
x0 else Float
x2
 | Bool
otherwise = Float
0.0

-- | Additional function to prepend zeroes to the given 'String'. The number of them are just that one to fulfill the length to the given 'Int' parameter.
prependZeroes :: Int -> String -> String 
prependZeroes :: Int -> ShowS
prependZeroes Int
n FilePath
xs 
  | if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs then Bool
True else Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
xs = FilePath
xs
  | Bool
otherwise = Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
xs) Char
'0' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
xs
{-# INLINE prependZeroes #-}  

nOfZeroesLog :: Int -> Maybe Int
nOfZeroesLog :: Int -> Maybe Int
nOfZeroesLog Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe Int
forall a. Maybe a
Nothing
  | Bool
otherwise = Int -> Maybe Int
forall a. a -> Maybe a
Just (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE nOfZeroesLog #-}  

-- | Is a minimal number of decimal places that are just enough to represent a length of the list given. For an [] returns 0.
numVZeroesPre :: [a] -> Int
numVZeroesPre :: [a] -> Int
numVZeroesPre [a]
ks = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
0 :: Int) (Int -> Maybe Int
nOfZeroesLog (Int -> Maybe Int) -> ([a] -> Int) -> [a] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Maybe Int) -> [a] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [a]
ks)
{-# INLINE numVZeroesPre #-}      

-- | Similarly to 'liftInOctaveV' returns a ['Float'] (actually frequencies) for the n-th elements set of notes (see 'nkyT') instead of octaves.
-- A second 'Int' parameter defines that @n@. 
liftInEnkuV :: Int -> Int -> [Float] -> [Float]
liftInEnkuV :: Int -> Int -> [Float] -> [Float]
liftInEnkuV Int
n Int
ku = (Float -> Maybe Float) -> [Float] -> [Float]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Int -> Float -> Maybe Float
liftInEnku Int
n Int
ku)

-- | Similarly to 'liftInOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT').
-- A second 'Int' parameter defines that @n@. Not all pairs return 'Just' @x@. 
liftInEnku :: Int -> Int -> Float -> Maybe Float
liftInEnku :: Int -> Int -> Float -> Maybe Float
liftInEnku Int
n Int
ku Float
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ((Int
108 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
ku) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) = Maybe Float
forall a. Maybe a
Nothing
  | 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
2,Int
3,Int
4,Int
6,Int
9,Int
12] ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
ku Bool -> Bool -> Bool
&& Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
24.4996 =
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (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
. Int -> Float -> Maybe Int
whichEnka Int
ku (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
x) Int
n of
        Ordering
EQ -> Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Float
closestNote Float
x)
        Ordering
LT -> let z :: Float
z  = Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2.0 (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ku) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float
closestNote Float
x)
                  z1 :: Integer
z1 = Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
z in
                   if Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.999 Bool -> Bool -> Bool
|| Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.001
                     then Float -> Maybe Float
forall a. a -> Maybe a
Just ([Float] -> Float
forall a. [a] -> a
last ([Float] -> Float) -> (Float -> [Float]) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take  (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Float] -> [Float]) -> (Float -> [Float]) -> Float -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> Float -> [Float]
forall a. (a -> a) -> a -> [a]
iterate' (Int -> Float -> Float
enkuUp Int
ku) (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
                     else Float -> Maybe Float
forall a. a -> Maybe a
Just ([Float] -> Float
forall a. [a] -> a
last ([Float] -> Float) -> (Float -> [Float]) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take  (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ([Float] -> [Float]) -> (Float -> [Float]) -> Float -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> Float -> [Float]
forall a. (a -> a) -> a -> [a]
iterate' (Int -> Float -> Float
enkuUp Int
ku) (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
        Ordering
_  -> let z :: Float
z  = Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2.0 (Float -> Float
closestNote Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ku))
                  z1 :: Integer
z1 = Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
z in
                   if Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.999 Bool -> Bool -> Bool
|| Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.001
                     then Float -> Maybe Float
forall a. a -> Maybe a
Just ([Float] -> Float
forall a. [a] -> a
last ([Float] -> Float) -> (Float -> [Float]) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ([Float] -> [Float]) -> (Float -> [Float]) -> Float -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> Float -> [Float]
forall a. (a -> a) -> a -> [a]
iterate' (Int -> Float -> Float
enkuDown Int
ku) (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
                     else Float -> Maybe Float
forall a. a -> Maybe a
Just ([Float] -> Float
forall a. [a] -> a
last ([Float] -> Float) -> (Float -> [Float]) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Float] -> [Float]) -> (Float -> [Float]) -> Float -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float) -> Float -> [Float]
forall a. (a -> a) -> a -> [a]
iterate' (Int -> Float -> Float
enkuDown Int
ku) (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
  | Bool
otherwise = Maybe Float
forall a. Maybe a
Nothing

-- | Similarly to 'whichOctave' returns a 'Maybe' number for the n-th elements set of notes (see 'nkyT').
-- An 'Int' parameter defines that @n@.
whichEnka :: Int -> Float -> Maybe Int
whichEnka :: Int -> Float -> Maybe Int
whichEnka Int
n Float
x
  | 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
2,Int
3,Int
4,Int
6,Int
9,Int
12] ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
n Bool -> Bool -> Bool
&& Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0 Bool -> Bool -> Bool
&& Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
108 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase (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
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12.0)) (((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Array Int (Float, Float) -> (Float, Float))
-> Array Int (Float, Float)
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Float, Float) -> (Float, Float)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Float, Float) -> (Float, Float))
-> (Array Int (Float, Float) -> Maybe (Float, Float))
-> Array Int (Float, Float)
-> (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Bool)
-> Array Int (Float, Float) -> Maybe (Float, Float)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(Float
t1, Float
_) -> Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
t1) (Array Int (Float, Float) -> Float)
-> Array Int (Float, Float) -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Array Int (Float, Float)
nkyT Int
n) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1))
  | 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
2,Int
3,Int
4,Int
6,Int
9,Int
12] ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
n Bool -> Bool -> Bool
&& Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
108 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
108 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
n)
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing 

-- | Returns an analogous note in the higher n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@.
enkuUp  :: Int -> Float -> Float
enkuUp :: Int -> Float -> Float
enkuUp Int
n Float
x
  | 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
2..Int
11] ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
n = 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
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x
  | Bool
otherwise = Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x
{-# INLINE enkuUp #-}  

-- | Returns an analogous note in the lower n-th elements set (its frequency in Hz) (see 'nkyT'). An 'Int' parameter defines this @n@.
enkuDown  :: Int -> Float -> Float
enkuDown :: Int -> Float -> Float
enkuDown Int
n Float
x
  | 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
2..Int
11] ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
n = 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
n) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x
  | Bool
otherwise = Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
{-# INLINE enkuDown #-}

-- | Returns a 'Array' 'Int' of tuples with the lowest and highest frequencies for the notes in the sets consisting of @n@ consequential notes
-- (including semi-tones). An 'Int' argument defines this @n@. It can be 2, 3, 4, 6, 9, or 12 (the last one is for default octaves, see 'octavesT').
-- So for different valid @n@ you obtain doubles, triples and so on. The function being applied returns a 'Array' 'Int' of such sets with
-- their respective lowest and highest frequencies.
nkyT :: Int -> NotePairs
nkyT :: Int -> Array Int (Float, Float)
nkyT Int
n
  | 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
2,Int
3,Int
4,Int
6,Int
9,Int
12] ([Bool] -> [(Int, Bool)])
-> (Bool -> [Bool]) -> Bool -> [(Int, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Bool]
forall a. a -> [a]
repeat (Bool -> [(Int, Bool)]) -> Bool -> [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
True) Int
n = (Int -> (Float, Float))
-> Array Int Int -> Array Int (Float, Float)
forall a b i. (a -> b) -> Array i a -> Array i b
amap (\Int
i -> (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n),
       Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))) (Array Int Int -> Array Int (Float, Float))
-> ([Int] -> Array Int Int) -> [Int] -> Array Int (Float, Float)
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
k) ([Int] -> Array Int (Float, Float))
-> [Int] -> Array Int (Float, Float)
forall a b. (a -> b) -> a -> b
$ [Int
0..Int
k]
  | Bool
otherwise = Array Int (Float, Float)
octavesT
     where !k :: Int
k = (Int
108 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Returns a 'Array' 'Int' of tuples with the lowest and highest frequencies for the notes in the octaves.
octavesT :: NotePairs
octavesT :: Array Int (Float, Float)
octavesT = (Int -> (Float, Float))
-> Array Int Int -> Array Int (Float, Float)
forall a b i. (a -> b) -> Array i a -> Array i b
amap (\Int
i -> (Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12), Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
11))) (Array Int Int -> Array Int (Float, Float))
-> ([Int] -> Array Int Int) -> [Int] -> Array Int (Float, Float)
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
8) ([Int] -> Array Int (Float, Float))
-> [Int] -> Array Int (Float, Float)
forall a b. (a -> b) -> a -> b
$ [Int
0..Int
8]

-- | For the given frequency it generates a musical sound with a timbre. The main component of the sound includes the lower pure quint,
-- which can be in the same octave or in the one with the number lower by one. Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
overSoXSynth :: Float -> IO ()
overSoXSynth :: Float -> IO ()
overSoXSynth = (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG Float -> OvertonesO
overTones
{-# INLINE overSoXSynth #-}

-- | Similar to 'overSoXSynth' but uses 'overTonesALaClarinet' instead of 'overTones'.
overSoXSynthALaClarinet :: Float -> IO ()
overSoXSynthALaClarinet :: Float -> IO ()
overSoXSynthALaClarinet = (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG Float -> OvertonesO
overTonesALaClarinet
{-# INLINE overSoXSynthALaClarinet #-}

-- | Generalized variant of the 'overSoXSynth' with the possibility to set the variant of the overtones for the notes as the
-- first argument.
overSoXSynthG :: (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG :: (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG Float -> OvertonesO
g Float
x = do
  let !note0 :: Float
note0 = if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
closestNote (Float -> Float
forall a. Num a => a -> a
abs Float
x) else Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0
      !note1 :: Float
note1 = Float -> Float
pureQuintNote Float
note0
      !v0 :: OvertonesO
v0    = Float -> OvertonesO
g Float
note0
      !v1 :: OvertonesO
v1    = Float -> OvertonesO
g Float
note1
      overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = ((Integer, (Float, Float)) -> IO (ExitCode, FilePath, FilePath))
-> [(Integer, (Float, Float))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
i, (Float
noteN, !Float
amplN)) -> FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox"))
        [FilePath
"-r22050", FilePath
"-n", FilePath
"test0" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav", FilePath
"synth", FilePath
"0.5",FilePath
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN FilePath
"", FilePath
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN FilePath
""] FilePath
"") ([(Integer, (Float, Float))] -> IO ())
-> (OvertonesO -> [(Integer, (Float, Float))])
-> OvertonesO
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> OvertonesO -> [(Integer, (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..]
      overSoXSynthHelp2 :: OvertonesO -> IO ()
overSoXSynthHelp2 = ((Integer, (Float, Float)) -> IO (ExitCode, FilePath, FilePath))
-> [(Integer, (Float, Float))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
i, (Float
noteN, !Float
amplN)) -> FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox"))
        [FilePath
"-r22050", FilePath
"-n", FilePath
"test1" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav", FilePath
"synth", FilePath
"0.5",FilePath
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN FilePath
"", FilePath
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN FilePath
""] FilePath
"") ([(Integer, (Float, Float))] -> IO ())
-> (OvertonesO -> [(Integer, (Float, Float))])
-> OvertonesO
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> OvertonesO -> [(Integer, (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..]
  (ExitCode, FilePath, FilePath)
_ <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe FilePath
showE FilePath
"sox")) [FilePath
"-r22050", FilePath
"-n", FilePath
"test01.wav", FilePath
"synth", FilePath
"0.5",FilePath
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 FilePath
"", FilePath
"synth", FilePath
"0.5",FilePath
"sine", FilePath
"mix", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note1 FilePath
"", FilePath
"vol",FilePath
"0.5"] FilePath
""
  OvertonesO -> IO ()
overSoXSynthHelp OvertonesO
v0
  OvertonesO -> IO ()
overSoXSynthHelp2 OvertonesO
v1
  IO ()
mixTest

-- | Returns a pure quint lower than the given note.
pureQuintNote :: Float -> Float
pureQuintNote :: Float -> Float
pureQuintNote Float
x = Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Float
7 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12)
{-# INLINE pureQuintNote #-}

-- | For the given frequency of the note it generates a list of the tuples, each one of which contains the harmonics' frequency and amplitude.
overTones :: Float -> OvertonesO
overTones :: Float -> OvertonesO
overTones Float
note =
  ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(!Float
w,!Float
z) -> Float
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
107 Bool -> Bool -> Bool
&& Float -> Float
forall a. Num a => a -> a
abs Float
z Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.001) (OvertonesO -> OvertonesO)
-> ([Integer] -> OvertonesO) -> [Integer] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> (Float, Float)) -> [Integer] -> OvertonesO
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i ->
    (Float
note Float -> Float -> Float
forall a. Num a => a -> a -> a
* Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2), Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)))) ([Integer] -> OvertonesO) -> [Integer] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ [Integer
0..Integer
1023]

overTonesALaClarinet :: Float -> OvertonesO
overTonesALaClarinet :: Float -> OvertonesO
overTonesALaClarinet Float
note =
  ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(!Float
w,!Float
z) -> Float
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
107 Bool -> Bool -> Bool
&& Float -> Float
forall a. Num a => a -> a
abs Float
z Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.001) (OvertonesO -> OvertonesO)
-> ([Integer] -> OvertonesO) -> [Integer] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> (Float, Float)) -> [Integer] -> OvertonesO
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i ->
    (Float
note Float -> Float -> Float
forall a. Num a => a -> a -> a
* Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1), Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)))) ([Integer] -> OvertonesO) -> [Integer] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ [Integer
0..Integer
512]

-- | Function can be used to determine to which octave (in the American notation for the notes, this is a number in the note written form,
-- e. g. for C4 this is 4) the frequency belongs (to be more exact, the closest note for the given frequency -- see 'closestNote' taking into account
-- its lower pure quint, which can lay in the lower by 1 octave). If it is not practical to determine the number, then the function returns 'Nothing'.
whichOctave :: Float -> Maybe Int
whichOctave :: Float -> Maybe Int
whichOctave Float
x
  | Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
24.4996 Bool -> Bool -> Bool
&& Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
95 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2 (((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Array Int (Float, Float) -> (Float, Float))
-> Array Int (Float, Float)
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Float, Float) -> (Float, Float)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Float, Float) -> (Float, Float))
-> (Array Int (Float, Float) -> Maybe (Float, Float))
-> Array Int (Float, Float)
-> (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Bool)
-> Array Int (Float, Float) -> Maybe (Float, Float)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(Float
t1, Float
_) -> Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
t1) (Array Int (Float, Float) -> Float)
-> Array Int (Float, Float) -> Float
forall a b. (a -> b) -> a -> b
$ Array Int (Float, Float)
octavesT) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1))
  | Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
95 = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

-- | Generalized version of the 'whichOctave'.
whichOctaveG :: Float -> Maybe Int
whichOctaveG :: Float -> Maybe Int
whichOctaveG Float
x 
  | Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0 Bool -> Bool -> Bool
&& Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
95 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2 (((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Array Int (Float, Float) -> (Float, Float))
-> Array Int (Float, Float)
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Float, Float) -> (Float, Float)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Float, Float) -> (Float, Float))
-> (Array Int (Float, Float) -> Maybe (Float, Float))
-> Array Int (Float, Float)
-> (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Bool)
-> Array Int (Float, Float) -> Maybe (Float, Float)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(Float
t1, Float
_) -> Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
t1) (Array Int (Float, Float) -> Float)
-> Array Int (Float, Float) -> Float
forall a b. (a -> b) -> a -> b
$ Array Int (Float, Float)
octavesT) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1))
  | Float -> Float
closestNote Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
95 = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

-- | Is used internally in the 'readProcessWithExitCode' to adjust volume for the sound with additional dB value given by 'Float' argument.
adjust_dbVol :: [String] -> Float -> [String]
adjust_dbVol :: [FilePath] -> Float -> [FilePath]
adjust_dbVol [FilePath]
xss Float
y
 | Float
y Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 = [FilePath]
xss
 | Bool
otherwise = [FilePath]
xss [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"vol",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y FilePath
"dB"]