-- |
-- Module      :  DobutokO.Sound.Functional.Basics
-- Copyright   :  (c) OleksandrZhabenko 2020, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Helps to create experimental music from a file (or its part) and a Ukrainian text. 
-- It can also generate a timbre for the notes. Uses SoX inside. Is more complicated than
-- dobutokO2 and uses its functionality.

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

module DobutokO.Sound.Functional.Basics (
  -- * Type synonyms with different semantics
  SoundsO
  , OvertonesO
  , NotePairs
  -- * Work with notes (general)
  , notes
  , neighbourNotes
  , closestNote
  , pureQuintNote 
  , overTones 
  -- * Work with overtones
  , overSoXSynth 
  -- * 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_k
  , partialTest_k1G
  , partialTest_k2G
  , prependZeroes 
  , nOfZeroesLog 
  , numVZeroesPre
  , duration1000
  , adjust_dbVol
) where

import GHC.Arr
import CaseBi.Arr (getBFst')
import Data.Char (isDigit)
import System.Exit (ExitCode( ExitSuccess ))
import Numeric
import Data.List (isPrefixOf,sort)
import Data.Maybe (fromJust,isJust,fromMaybe)
import qualified Data.Vector as V
import Sound.SoXBasics (durationA)
import System.Process
import EndOfExe2
import System.Directory
import DobutokO.Sound.IntermediateF

-- | Is used to represent a sequence of intervals, each note being a 'Float' value (its frequency in Hz).
type SoundsO = V.Vector (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 = V.Vector (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 = V.Vector (Float, Float)

-- | Gets 'V.Vector' of '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 (V.Vector Int)
freqsFromFile :: [Char] -> Int -> IO (Vector Int)
freqsFromFile [Char]
file Int
n = Int -> (Int -> IO Int) -> IO (Vector Int)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM Int
n (\Int
k -> do {
    (_, _, herr) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) [[Char]
file, [Char]
"-n", [Char]
"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) [Char]
"",
      [Char]
"0.001", [Char]
"stat"] [Char]
""
    ; let line0s = [Char] -> [[Char]]
lines [Char]
herr
          noteN0 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit ShowS -> ([[Char]] -> [Char]) -> [[Char]] -> [Char]
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 -> ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
13 ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
14 ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
line0s
    ; if null noteN0 then return (11440::Int)
      else let noteN1  = [Char] -> Int
forall a. Read a => [Char] -> a
read ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit ShowS -> ([[Char]] -> [Char]) -> [[Char]] -> [Char]
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 -> ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
13 ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
14 ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
line0s)::Int in return noteN1 })

-- | 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
  paths0 <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let paths = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"test") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
paths0
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
  mapM_ removeFile 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 :: [Char] -> IO ()
mixTest2G [Char]
ys = do
  paths0 <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let paths = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"test") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
paths0
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result.wav","vol","0.3"]) ""
  mapM_ removeFile 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
  paths0 <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let paths = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"test") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
paths0
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result" ++ prependZeroes zeroN (show j) ++ ".wav",
    "vol","0.3"]) ""
  mapM_ removeFile 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 -> [Char] -> IO ()
mixTest22G Int
zeroN Int
j [Char]
ys = do
  paths0 <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let paths = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"test") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
paths0
  _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ soxBasicParams ys ["","result" ++ prependZeroes zeroN (show j) ++
      ".wav","vol","0.3"]) ""
  mapM_ removeFile 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
  path2s <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let paths3 = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"result") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
path2s
  (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ ["end.wav"]) ""
  case code of
    ExitCode
ExitSuccess -> [Char] -> IO ()
putStrLn [Char]
"The final file \"end.wav\" was successfully created. You can now manually change or delete \"result*\" files in the directory. "
    ExitCode
_           -> do
      exi <- [Char] -> IO Bool
doesFileExist [Char]
"end.wav"
      if exi then removeFile "end.wav"
      else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >>
        putStrLn "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 :: [Char] -> IO ()
endFromResult2G [Char]
ys = do
  path2s <- [Char] -> IO [[Char]]
listDirectory [Char]
"."
  let paths3 = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"result") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
path2s
  (code,_,_) <- readProcessWithExitCode (fromJust (showE "sox")) (paths3 ++ soxBasicParams ys ["","end.wav"]) ""
  case code of
    ExitCode
ExitSuccess -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"The final file \"end." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
"flac" else [Char]
"wav" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" was successfully created. You can now manually change or delete \"result*\" files in the directory. "
    ExitCode
_           -> do
      exi <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"end." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
"flac" else [Char]
"wav"
      if exi then removeFile $ "end." ++ if drop 3 ys == "f" then "flac" else "wav"
      else putStr "Your final file \"end.wav\" was not created by some reason, but the intermediate files in the respective order are present. " >>
        putStrLn "Use them manually as needed."            

-- | Creates part of the needed \"test\*\.wav" files in the current directory. 
partialTest_k :: OvertonesO -> Int -> String -> IO ()
partialTest_k :: OvertonesO -> Int -> [Char] -> IO ()
partialTest_k OvertonesO
vec Int
k [Char]
ts = OvertonesO -> Int -> [Char] -> Vector Float -> [Char] -> IO ()
partialTest_k2G OvertonesO
vec Int
k [Char]
ts Vector Float
forall a. Vector a
V.empty []

-- | Generalized version of the 'partialTest_k' with the additional volume adjustment in dB given by 'V.Vector' of 'Float'.
partialTest_k1G :: OvertonesO -> Int -> String -> V.Vector Float -> IO ()
partialTest_k1G :: OvertonesO -> Int -> [Char] -> Vector Float -> IO ()
partialTest_k1G OvertonesO
vec Int
k [Char]
ts Vector Float
vdB = OvertonesO -> Int -> [Char] -> Vector Float -> [Char] -> IO ()
partialTest_k2G OvertonesO
vec Int
k [Char]
ts Vector Float
vdB []

-- | 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 -> V.Vector Float -> String -> IO ()
partialTest_k2G :: OvertonesO -> Int -> [Char] -> Vector Float -> [Char] -> IO ()
partialTest_k2G OvertonesO
vec Int
k [Char]
ts Vector Float
vdB [Char]
ys =
  let zeroN :: Int
zeroN = OvertonesO -> Int
forall a. Vector a -> Int
numVZeroesPre OvertonesO
vec in (Int -> (Float, Float) -> IO ()) -> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\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
      _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ([Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys ([[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]
"-r22050", [Char]
"-n", [Char]
"test" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav",
         [Char]
"synth", [Char]
ts,[Char]
"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) [Char]
"", [Char]
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
""]
            (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) [Char]
""
      path1s <- listDirectory "."
      let path2s = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf ([Char] -> [Char] -> Bool) -> [Char] -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"test" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
path1s
      (code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ soxBasicParams ys ["","test-" ++ show k ++
        prependZeroes zeroN (show (i `quot` 50)) ++ ".wav"]) ""
      case code of
        ExitCode
ExitSuccess -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
removeFile [[Char]]
path2s
        ExitCode
_           -> do
          exi <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"test-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
zeroN (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
50)) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"f" then [Char]
".flac" else [Char]
".wav"
          if exi then putStrLn (herr0) >> removeFile ("test-" ++ show k ++ prependZeroes zeroN (show (i `quot` 50)) ++ if drop 3 ys == "f" then ".flac" else ".wav")
          else putStrLn herr0
    else [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) ((if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys then [[Char]] -> [[Char]]
forall a. a -> a
id else [Char] -> [[Char]] -> [[Char]]
soxBasicParams [Char]
ys) ((if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
vdB then [[Char]] -> [[Char]]
forall a. a -> a
id 
      else (\[[Char]]
wwws -> [[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]]
wwws (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
vdB Int
i))) [[Char]
"-r22050", [Char]
"-n", [Char]
"test" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav",
       [Char]
"synth", [Char]
ts,[Char]
"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) [Char]
"", [Char]
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
""])) [Char]
"" IO (ExitCode, [Char], [Char]) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO ()
putStr [Char]
"") OvertonesO
vec

-- | Auxiliary function to get from a sound file specified a duration parameter @n@ that can be used further.
duration1000 :: FilePath -> IO Int
duration1000 :: [Char] -> IO Int
duration1000 [Char]
file = (Float -> Int) -> IO Float -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Float
t -> Float -> Int
forall b. Integral b => Float -> b
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) -> ([Char] -> IO Float) -> [Char] -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Float
durationA ([Char] -> IO Int) -> [Char] -> IO Int
forall a b. (a -> b) -> a -> b
$ [Char]
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 (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector 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 (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector 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))

-- | 'V.Vector' of musical notes in Hz.
notes :: V.Vector Float
-- notes V.! 57 = 440.0   -- A4 in Hz
notes :: Vector Float
notes = Int -> (Int -> Float) -> Vector Float
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
108 (\Int
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
** (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
57) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12))

-- | 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 -> V.Vector Float -> (Float, Float)
neighbourNotes :: Float -> Vector Float -> (Float, Float)
neighbourNotes Float
x Vector Float
v
  | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v Int
0) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v Int
0, Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v Int
0)
  | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1), Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v) Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex  Vector Float
v (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT
      then Float -> Vector Float -> (Float, Float)
neighbourNotes Float
x (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
0 (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Vector Float
v)
      else Float -> Vector Float -> (Float, Float)
neighbourNotes Float
x (Int -> Int -> Vector Float -> Vector Float
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)) Vector Float
v)
  | Bool
otherwise = (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v Int
0, Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v (Vector Float -> Int
forall a. Vector a -> Int
V.length Vector Float
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

-- | Returns the closest note to the given frequency in Hz.  
closestNote :: Float -> Float
closestNote :: Float -> Float
closestNote Float
x
 | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
0.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT =
    let (Float
x0, Float
x2) = Float -> Vector Float -> (Float, Float)
neighbourNotes Float
x Vector Float
notes
        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 -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
r2 Float
r0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
       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 [Char]
xs 
  | if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
xs then Bool
True else Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = [Char]
xs
  | Bool
otherwise = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs) Char
'0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
xs
{-# INLINE prependZeroes #-}  

nOfZeroesLog :: Int -> Maybe Int
nOfZeroesLog :: Int -> Maybe Int
nOfZeroesLog Int
x
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = Maybe Int
forall a. Maybe a
Nothing
  | Bool
otherwise = Int -> Maybe Int
forall a. a -> Maybe a
Just (Double -> Int
forall b. Integral b => Double -> b
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 'V.Vector' given. For an 'V.empty' returns 0.
numVZeroesPre :: V.Vector a -> Int
numVZeroesPre :: forall a. Vector a -> Int
numVZeroesPre Vector a
v = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
0 :: Int) (Int -> Maybe Int
nOfZeroesLog (Int -> Maybe Int) -> (Vector a -> Int) -> Vector a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Int
forall a. Vector a -> Int
V.length (Vector a -> Maybe Int) -> Vector a -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Vector a
v)
{-# INLINE numVZeroesPre #-}      

-- | Similarly to 'liftInOctaveV' returns a 'V.Vector' '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 -> V.Vector Float -> V.Vector Float
liftInEnkuV :: Int -> Int -> Vector Float -> Vector Float
liftInEnkuV Int
n Int
ku = (Float -> Maybe Float) -> Vector Float -> Vector Float
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.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 -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT Bool -> Bool -> Bool
|| Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n ((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) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = Maybe Float
forall a. Maybe a
Nothing
  | (Bool, Array Int (Int, Bool)) -> Int -> Bool
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Bool
False, (Int, Int) -> [(Int, Bool)] -> Array Int (Int, Bool)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) ([(Int, Bool)] -> Array Int (Int, Bool))
-> ([Bool] -> [(Int, Bool)]) -> [Bool] -> Array Int (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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] -> Array Int (Int, Bool))
-> [Bool] -> Array Int (Int, Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True) Int
ku Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) Float
24.4996 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT =
      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 (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector 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 b. Integral b => Float -> b
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 (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (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) (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 (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (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) (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
/ Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ku))
                  z1 :: Integer
z1 = Float -> Integer
forall b. Integral b => Float -> b
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 (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (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) (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 (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (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) (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 (actually frequency) 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, Array Int (Int, Bool)) -> Int -> Bool
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Bool
False,(Int, Int) -> [(Int, Bool)] -> Array Int (Int, Bool)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) ([(Int, Bool)] -> Array Int (Int, Bool))
-> ([Bool] -> [(Int, Bool)]) -> [Bool] -> Array Int (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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] -> Array Int (Int, Bool))
-> [Bool] -> Array Int (Int, Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True) Int
n Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) Float
24.4996 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = (\Maybe Int
t ->
     case Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
t of 
       Bool
True -> (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
z ->
         case Int
z of
           Int
0 -> Int
z
           Int
_ -> Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe Int
t
       Bool
_    -> Int -> Maybe Int
forall a. a -> Maybe a
Just ((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)) (Maybe Int -> Maybe Int) -> (Int -> Maybe Int) -> Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Bool) -> OvertonesO -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (\(Float
t1, Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) Float
t1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) (OvertonesO -> Maybe Int)
-> (Int -> OvertonesO) -> Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> OvertonesO
nkyT (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ 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, Array Int (Int, Bool)) -> Int -> Bool
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Bool
False, (Int, Int) -> [(Int, Bool)] -> Array Int (Int, Bool)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
9) ([(Int, Bool)] -> Array Int (Int, Bool))
-> ([Bool] -> [(Int, Bool)]) -> [Bool] -> Array Int (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
2..Int
11] ([Bool] -> Array Int (Int, Bool))
-> [Bool] -> Array Int (Int, Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> [Bool]
forall a. a -> [a]
repeat 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, Array Int (Int, Bool)) -> Int -> Bool
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Bool
False, (Int, Int) -> [(Int, Bool)] -> Array Int (Int, Bool)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
9) ([(Int, Bool)] -> Array Int (Int, Bool))
-> ([Bool] -> [(Int, Bool)]) -> [Bool] -> Array Int (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
2..Int
11] ([Bool] -> Array Int (Int, Bool))
-> [Bool] -> Array Int (Int, Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> [Bool]
forall a. a -> [a]
repeat 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 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the sets consisting of @n@ consequential notes
-- (including semi-tones). An 'Int' parameter 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 'V.Vector' of such sets with
-- their respective lowest and highest frequencies.
nkyT :: Int -> NotePairs
nkyT :: Int -> OvertonesO
nkyT Int
n
  | (Bool, Array Int (Int, Bool)) -> Int -> Bool
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Bool
False,(Int, Int) -> [(Int, Bool)] -> Array Int (Int, Bool)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
5) ([(Int, Bool)] -> Array Int (Int, Bool))
-> ([Bool] -> [(Int, Bool)]) -> [Bool] -> Array Int (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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] -> Array Int (Int, Bool))
-> [Bool] -> Array Int (Int, Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True) Int
n = Int -> (Int -> (Float, Float)) -> OvertonesO
forall a. Int -> (Int -> a) -> Vector a
V.generate (Int
108 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
n) (\Int
i -> (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n),
       Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector 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))))
  | Bool
otherwise = OvertonesO
octavesT

-- | Returns a 'V.Vector' of tuples with the lowest and highest frequencies for the notes in the octaves.
octavesT :: NotePairs
octavesT :: OvertonesO
octavesT = Int -> (Int -> (Float, Float)) -> OvertonesO
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
9 (\Int
i -> (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12), Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector 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)))

-- | 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
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 Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0
      note1 :: Float
note1 = Float -> Float
pureQuintNote Float
note0
      v0 :: OvertonesO
v0    = Float -> OvertonesO
overTones Float
note0
      v1 :: OvertonesO
v1    = Float -> OvertonesO
overTones Float
note1
      overSoXSynthHelp :: OvertonesO -> IO ()
overSoXSynthHelp = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
        [[Char]
"-r22050", [Char]
"-n", [Char]
"test0" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
"0.5",[Char]
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
""] [Char]
"")
      overSoXSynthHelp2 :: OvertonesO -> IO ()
overSoXSynthHelp2 = (Int -> (Float, Float) -> IO (ExitCode, [Char], [Char]))
-> OvertonesO -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (\Int
i (Float
noteN, !Float
amplN) -> [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox"))
        [[Char]
"-r22050", [Char]
"-n", [Char]
"test1" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".wav", [Char]
"synth", [Char]
"0.5",[Char]
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
noteN [Char]
"", [Char]
"vol", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
amplN [Char]
""] [Char]
"")
  _ <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode (Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe [Char]
showE [Char]
"sox")) [[Char]
"-r22050", [Char]
"-n", [Char]
"test01.wav", [Char]
"synth", [Char]
"0.5",[Char]
"sine", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note0 [Char]
"", [Char]
"synth", [Char]
"0.5",[Char]
"sine", [Char]
"mix", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
note1 [Char]
"", [Char]
"vol",[Char]
"0.5"] [Char]
""
  overSoXSynthHelp v0
  overSoXSynthHelp2 v1
  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 'V.Vector' 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) -> Vector a -> Vector a
V.takeWhile (\(!Float
w,!Float
z) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
w (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
z) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (OvertonesO -> OvertonesO)
-> (Vector Float -> OvertonesO) -> Vector Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Float -> Vector Float -> OvertonesO
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip (Int -> (Int -> Float) -> Vector Float
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
1024 (\Int
i ->
    Float
note Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))) (Vector Float -> OvertonesO) -> Vector Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ (Int -> (Int -> Float) -> Vector Float
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
1024 (\Int
i -> Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))))

-- | 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 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) Float
24.4996 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = (\Maybe Int
t ->
     case Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
t of 
       Bool
True -> (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
z ->
         case Int
z of
           Int
0 -> Int
z
           Int
_ -> Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe Int
t
       Bool
_    -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) (Maybe Int -> Maybe Int)
-> (OvertonesO -> Maybe Int) -> OvertonesO -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Bool) -> OvertonesO -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (\(Float
t1, Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) Float
t1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) (OvertonesO -> Maybe Int) -> OvertonesO -> Maybe Int
forall a b. (a -> b) -> a -> b
$ OvertonesO
octavesT
  | 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 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
107) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = (\Maybe Int
t ->
     case Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
t of 
       Bool
True -> (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
z ->
         case Int
z of
           Int
0 -> Int
z
           Int
_ -> Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe Int
t
       Bool
_    -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) (Maybe Int -> Maybe Int)
-> (OvertonesO -> Maybe Int) -> OvertonesO -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Bool) -> OvertonesO -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (\(Float
t1, Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) Float
t1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) (OvertonesO -> Maybe Int) -> OvertonesO -> Maybe Int
forall a b. (a -> b) -> a -> b
$ OvertonesO
octavesT
  | 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 :: [[Char]] -> Float -> [[Char]]
adjust_dbVol [[Char]]
xss Float
y
 | Float
y Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 = [[Char]]
xss
 | Bool
otherwise = [[Char]]
xss [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"vol",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y [Char]
"dB"]