{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module Composition.Sound.Functional.Basics (
SoundsO
, OvertonesO
, NotePairs
, notes
, neighbourNotes
, closestNote
, pureQuintNote
, overTones
, overTonesALaClarinet
, overSoXSynth
, overSoXSynthALaClarinet
, overSoXSynthG
, overSoXSynthGG
, nkyT
, whichOctave
, whichOctaveG
, whichEnka
, enkuUp
, enkuDown
, liftInEnkuV
, liftInEnku
, octavesT
, mixTest
, mixTest2
, freqsFromFile
, endFromResult
, dNote
, mixTest2G
, mixTest22G
, endFromResult2G
, 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
type SoundsO = Array Int (Float, Float)
type OvertonesO = [(Float, Float)]
type NotePairs = Array Int (Float, Float)
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]
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
l :: Int
l = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
paths
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 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
"--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
""
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let zipp :: [[FilePath]]
zipp = [FilePath] -> [[FilePath]]
forall a. [a] -> [[a]]
intoHundreds [FilePath]
paths
[FilePath]
ress <- ((Integer, [FilePath]) -> IO FilePath)
-> [(Integer, [FilePath])] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Integer
i, [FilePath]
hundList) -> 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]
hundList [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"result" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
20 (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav"]) FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"result" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
l (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav")) ([(Integer, [FilePath])] -> IO [FilePath])
-> ([[FilePath]] -> [(Integer, [FilePath])])
-> [[FilePath]]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [[FilePath]] -> [(Integer, [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([[FilePath]] -> IO [FilePath]) -> [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]]
zipp
(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]
ress [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"result.wav"]) FilePath
""
[FilePath]
ress2 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
let ress3 :: [FilePath]
ress3 = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"result0") [FilePath]
ress2
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
ress3
(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
intoHundreds :: [a] -> [[a]]
intoHundreds :: [a] -> [[a]]
intoHundreds [a]
xs
| [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = []
| Bool
otherwise = [a]
ts [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. [a] -> [[a]]
intoHundreds [a]
zs
where ([a]
ts,[a]
zs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
100 [a]
xs
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
l :: Int
l = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
paths
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 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
"--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
""
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let zipp :: [[FilePath]]
zipp = [FilePath] -> [[FilePath]]
forall a. [a] -> [[a]]
intoHundreds [FilePath]
paths
[FilePath]
ress <- ((Integer, [FilePath]) -> IO FilePath)
-> [(Integer, [FilePath])] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Integer
i, [FilePath]
hundList) -> 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]
hundList [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
20 (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav"]) FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath
"",FilePath
"result" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
l (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav"])) ([(Integer, [FilePath])] -> IO [FilePath])
-> ([[FilePath]] -> [(Integer, [FilePath])])
-> [[FilePath]]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [[FilePath]] -> [(Integer, [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([[FilePath]] -> IO [FilePath]) -> [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]]
zipp
(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]
ress [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys [FilePath
"",FilePath
"result.wav"]) FilePath
""
[FilePath]
ress2 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
let ress3 :: [FilePath]
ress3 = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"result0") [FilePath]
ress2
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
ress3
(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
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
""
(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
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
""
(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
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
l :: Int
l = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
paths3
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 then do
(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
""
ExitCode -> IO ()
procPlusEnd ExitCode
code
else do
let zipp :: [[FilePath]]
zipp = [FilePath] -> [[FilePath]]
forall a. [a] -> [[a]]
intoHundreds [FilePath]
paths3
[FilePath]
ress <- ((Integer, [FilePath]) -> IO FilePath)
-> [(Integer, [FilePath])] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Integer
i, [FilePath]
hundList) -> 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]
hundList [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"end" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
20 (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav"]) FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"end" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
l (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav")) ([(Integer, [FilePath])] -> IO [FilePath])
-> ([[FilePath]] -> [(Integer, [FilePath])])
-> [[FilePath]]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [[FilePath]] -> [(Integer, [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([[FilePath]] -> IO [FilePath]) -> [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]]
zipp
(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]
ress [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"end.wav"]) FilePath
""
[FilePath]
ress2 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
let ress3 :: [FilePath]
ress3 = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"end0") [FilePath]
ress2
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
ress3
procPlusEnd :: ExitCode -> IO ()
procPlusEnd :: ExitCode -> IO ()
procPlusEnd ExitCode
code =
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."
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
l :: Int
l = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
paths3
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 then do
(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
""
ExitCode -> FilePath -> IO ()
procPlusEnd2G ExitCode
code FilePath
ys
else do
let zipp :: [[FilePath]]
zipp = [FilePath] -> [[FilePath]]
forall a. [a] -> [[a]]
intoHundreds [FilePath]
paths3
[FilePath]
ress <- ((Integer, [FilePath]) -> IO FilePath)
-> [(Integer, [FilePath])] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Integer
i, [FilePath]
hundList) -> 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]
hundList [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys [FilePath
"",FilePath
"end" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
20 (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav"]) FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath
"",FilePath
"end" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
prependZeroes Int
l (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".wav"])) ([(Integer, [FilePath])] -> IO [FilePath])
-> ([[FilePath]] -> [(Integer, [FilePath])])
-> [[FilePath]]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [[FilePath]] -> [(Integer, [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([[FilePath]] -> IO [FilePath]) -> [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]]
zipp
(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]
ress [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> [FilePath]
soxBasicParams FilePath
ys [FilePath
"",FilePath
"end.wav"]) FilePath
""
[FilePath]
ress2 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
let ress3 :: [FilePath]
ress3 = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"end0") [FilePath]
ress2
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
removeFile [FilePath]
ress3
procPlusEnd2G :: ExitCode -> String -> IO ()
procPlusEnd2G :: ExitCode -> FilePath -> IO ()
procPlusEnd2G ExitCode
code FilePath
ys =
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."
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 []
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
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
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
note 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
note 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 = 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))
notes :: Array Int Float
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]
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)
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
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 #-}
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 #-}
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)
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
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
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 #-}
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 #-}
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
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]
overSoXSynth :: Float -> IO ()
overSoXSynth :: Float -> IO ()
overSoXSynth = (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG Float -> OvertonesO
overTones
{-# INLINE overSoXSynth #-}
overSoXSynthALaClarinet :: Float -> IO ()
overSoXSynthALaClarinet :: Float -> IO ()
overSoXSynthALaClarinet = (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG Float -> OvertonesO
overTonesALaClarinet
{-# INLINE overSoXSynthALaClarinet #-}
overSoXSynthG :: (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG :: (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthG = [Float -> Float] -> (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthGG [Float -> Float
pureQuintNote]
{-# INLINE overSoXSynthG #-}
overSoXSynthGG :: [(Float -> Float)] -> (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthGG :: [Float -> Float] -> (Float -> OvertonesO) -> Float -> IO ()
overSoXSynthGG [Float -> Float]
progressionHarmonizerList 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
!notes1 :: [Float]
notes1 = ((Float -> Float) -> Float) -> [Float -> Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\Float -> Float
f -> Float -> Float
f Float
note0) [Float -> Float]
progressionHarmonizerList
!vs :: [OvertonesO]
vs = (Float -> OvertonesO) -> [Float] -> [OvertonesO]
forall a b. (a -> b) -> [a] -> [b]
map Float -> OvertonesO
g (Float
note0 Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
: [Float]
notes1)
overSoXSynthHelpG :: a -> [(a, a)] -> IO ()
overSoXSynthHelpG a
j = ((Integer, (a, a)) -> IO (ExitCode, FilePath, FilePath))
-> [(Integer, (a, a))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
i, (a
noteN, !a
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
"test" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
j 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 -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
noteN FilePath
"", FilePath
"vol", Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing a
amplN FilePath
""] FilePath
"") ([(Integer, (a, a))] -> IO ())
-> ([(a, a)] -> [(Integer, (a, a))]) -> [(a, a)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [(a, a)] -> [(Integer, (a, a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..]
((Integer, OvertonesO) -> IO ())
-> [(Integer, OvertonesO)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
j, OvertonesO
vel) -> Integer -> OvertonesO -> IO ()
forall a a a.
(Show a, RealFloat a, RealFloat a) =>
a -> [(a, a)] -> IO ()
overSoXSynthHelpG Integer
j OvertonesO
vel) ([(Integer, OvertonesO)] -> IO ())
-> ([OvertonesO] -> [(Integer, OvertonesO)])
-> [OvertonesO]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [OvertonesO] -> [(Integer, OvertonesO)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([OvertonesO] -> IO ()) -> [OvertonesO] -> IO ()
forall a b. (a -> b) -> a -> b
$ [OvertonesO]
vs
IO ()
mixTest
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 #-}
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]
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
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
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"]