{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}
module DobutokO.Sound.Functional (
oberSoXSynth2FDN
, oberSoXSynth2FDN_B
, oberSoXSynth2FDN_S
, oberSoXSynth2FDN_Sf
, oberSoXSynth2FDN_Sf3
) where
import System.Exit (ExitCode( ExitSuccess ))
import Numeric
import Data.List (isPrefixOf,sort,sortBy,nubBy)
import Data.Maybe (isNothing,fromJust)
import qualified Data.Vector as V
import System.Process
import EndOfExe
import System.Directory
import Melodics.Ukrainian
import DobutokO.Sound hiding (oberSoXSynth2FDN)
oberSoXSynth2FDN :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> String -> IO ()
oberSoXSynth2FDN f (x, y) zs
| V.null . convertToProperUkrainian $ zs = oberSoXSynth x
| otherwise = do
let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) ->
if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,
abs (amplX - (fromIntegral . truncate $ amplX)))) . f
g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) .
V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k
v0 = g note0
v1 = if isNothing note1 then V.empty
else g . fromJust $ note1
ts = showFFloat (Just 4) (abs y) $ show 0
oberSoXSynthHelp vec =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
oberSoXSynthHelp2 vec =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then do
oberSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
oberSoXSynth2FDN_B :: (Double -> V.Vector (Double, Double)) -> (Double, Double, Double) -> String -> IO ()
oberSoXSynth2FDN_B f (x, y, limB) zs
| V.null . convertToProperUkrainian $ zs = oberSoXSynth x
| otherwise = do
let limA0 = abs ((limB / fromIntegral 10) - (fromIntegral . truncate $ (limB / fromIntegral 10))) * fromIntegral 10
limA = if compare limA0 0.1 == LT then 0.1 else limA0
note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
g0 = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) ->
if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,
abs (amplX - (fromIntegral . truncate $ amplX)))) . f
g k = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) .
V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k
v0 = g note0
v1 = if isNothing note1 then V.empty
else g . fromJust $ note1
ts = showFFloat (Just 4) (abs y) $ show 0
oberSoXSynthHelp vec =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
oberSoXSynthHelp2 vec =
let l = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
"vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then do
oberSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
oberSoXSynth2FDN_S :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> String -> IO ()
oberSoXSynth2FDN_S f (x, y) zs
| V.null . convertToProperUkrainian $ zs = oberSoXSynth x
| otherwise = do
let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
v0 = f note0
v1 = if isNothing note1 then V.empty
else f . fromJust $ note1
ts = showFFloat (Just 4) (abs y) $ show 0
oberSoXSynthHelp vec =
let l = V.length vec
zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0
then do
path1s <- listDirectory "."
let path2s = sort . filter (isPrefixOf "test0") $ path1s
(code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) ""
case code of
ExitSuccess -> mapM_ removeFile path2s
_ -> do
exi <- doesFileExist $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"
if exi then putStrLn ("Line 161: " ++ herr0) >> removeFile ("test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav")
else putStrLn $ "Line 162: " ++ herr0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] ""
return ()) vec
oberSoXSynthHelp2 vec =
let l = V.length vec
zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0
then do
path3s <- listDirectory "."
let path4s = sort . filter (isPrefixOf "test1") $ path3s
(code2,_,herr2) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path4s ++ ["test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) ""
case code2 of
ExitSuccess -> mapM_ removeFile path4s
_ -> do
exi <- doesFileExist $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"
if exi then putStrLn ("Line 177: " ++ herr2) >> removeFile ("test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav")
else putStrLn $ "Line 178: " ++ herr2
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] ""
return ()) vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then do
oberSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
oberSoXSynth2FDN_Sf :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> String -> IO ()
oberSoXSynth2FDN_Sf f (x, y) zs
| V.null . convertToProperUkrainian $ zs = oberSoXSynth x
| otherwise = do
let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
v0 = V.filter (\(_,!z) -> compare (abs z) 0.001 == GT) . f $ note0
v1 = if isNothing note1 then V.empty
else V.filter (\(_,!z) -> compare z 0.001 == GT) . f . fromJust $ note1
ts = showFFloat (Just 4) (abs y) $ show 0
oberSoXSynthHelp vec =
let l = V.length vec
zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0
then do
path1s <- listDirectory "."
let path2s = sort . filter (isPrefixOf "test0") $ path1s
(code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) ""
case code of
ExitSuccess -> mapM_ removeFile path2s
_ -> do
exi <- doesFileExist $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"
if exi then putStrLn ("Line 224: " ++ herr0) >> (removeFile $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav")
else putStrLn $ "Line 225: " ++ herr0
else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec
oberSoXSynthHelp2 vec =
let l = V.length vec
zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0
then do
path3s <- listDirectory "."
let path4s = sort . filter (isPrefixOf "test1") $ path3s
(code,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path4s ++ ["test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) ""
case code of
ExitSuccess -> mapM_ removeFile path4s
_ -> do
exi <- doesFileExist $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"
if exi then putStrLn ("Line 239: " ++ herr1) >> (removeFile $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav")
else putStr $ "Line 240: " ++ herr1
else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then do
oberSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths
oberSoXSynth2FDN_Sf3 :: (Double -> V.Vector (Double, Double)) -> (Double, Double, Double) -> String -> IO ()
oberSoXSynth2FDN_Sf3 f (x, y, t0) zs
| V.null . convertToProperUkrainian $ zs = oberSoXSynth x
| otherwise = do
let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
v0 = V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f $ note0
v1 = if isNothing note1 then V.empty
else V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f . fromJust $ note1
ts = showFFloat (Just 4) (abs y) $ show 0
oberSoXSynthHelp vec =
let l = V.length vec
zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0
then do
path1s <- listDirectory "."
let path2s = sort . filter (isPrefixOf "test0") $ path1s
(code,_,herr0) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path2s ++ ["test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) ""
case code of
ExitSuccess -> mapM_ removeFile path2s
_ -> do
exi <- doesFileExist $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"
if exi then putStrLn ("Line 285: " ++ herr0) >> (removeFile $ "test-0" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav")
else putStrLn $ "Line 286: " ++ herr0
else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec
oberSoXSynthHelp2 vec =
let l = V.length vec
zeroN = numVZeroesPre vec in V.imapM_ (\i (noteN, !amplN) -> if i /= 0 && i `rem` 250 == 0
then do
path3s <- listDirectory "."
let path4s = sort . filter (isPrefixOf "test1") $ path3s
(code,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ path4s ++ ["test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"]) ""
case code of
ExitSuccess -> mapM_ removeFile path4s
_ -> do
exi <- doesFileExist $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav"
if exi then putStrLn ("Line 300: " ++ herr1) >> (removeFile $ "test-1" ++ prependZeroes zeroN (show (i `quot` 250)) ++ ".wav")
else putStrLn $ "Line 301: " ++ herr1
else readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine",
showFFloat (Just 4) (abs noteN) $ show 0, "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "" >> putStr "") vec
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) note0 $ show 0] ""
if isNothing note1 then do
oberSoXSynthHelp v0
else do
_ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) (abs y) $ show 0,"sine",
showFFloat (Just 4) (fromJust note1) $ show 0] ""
oberSoXSynthHelp v0
oberSoXSynthHelp2 v1
paths0 <- listDirectory "."
let paths = sort . filter (isPrefixOf "test") $ paths0
_ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
mapM_ removeFile paths