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

{-# OPTIONS_GHC -threaded #-}

module Composition.Sound.Process (
  -- * Basic functions for the executable
  recAndProcess
  , processD1
  --, processD2
  , d3H
  , d4H
  , d5H
  , d7H
  , d8H
  , d9H
) where

import Data.List (isPrefixOf)
import CaseBi.Arr (getBFstLSorted')
import Numeric (showFFloat)
import Control.Exception (onException)
import Sound.Control.Exception.FinalException
import System.Exit
import Data.Maybe (fromJust,isJust)
import Data.Char (isDigit,isSpace)
import System.Process
import System.Info (os)
import EndOfExe (showE)
import System.Directory

-- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing
-- whether there is no \"x.wav\" file in the current directory, because it can be overwritten.
recAndProcess :: FilePath -> Int -> IO String
recAndProcess :: FilePath -> Int -> IO FilePath
recAndProcess FilePath
file =
  IO FilePath -> [(Int, IO FilePath)] -> Int -> IO FilePath
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' IO FilePath
processD [(Int
0,FilePath -> IO FilePath
processD0 FilePath
file),(Int
1,IO FilePath
processD1), (Int
3,IO FilePath
processD3),(Int
4,IO FilePath
processD4),(Int
5,IO FilePath
processD5),
    (Int
7,IO FilePath
processD7), (Int
8,IO FilePath
processD8),(Int
9,IO FilePath
processD9),(Int
11,IO FilePath
processD_1),(Int
99,IO FilePath
processD99),(Int
999,IO FilePath
processD99)]

failureNotification :: IO ()
failureNotification :: IO ()
failureNotification = do
  FilePath -> IO ()
putStrLn FilePath
"The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
  FilePath -> IO ()
putStrLn FilePath
"_______________________________________________________________________"

processD_1 :: IO String
processD_1 :: IO FilePath
processD_1 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStr FilePath
"Please, specify two \'Int\' numbers (with intermediate space character between them): the first one is a number of different notes there will be "
  FilePath -> IO ()
putStr FilePath
"in the result, and the second one is a number of enky, to which you would like all the main components (not taking into account their "
  FilePath -> IO ()
putStr FilePath
"respective lower bases of the intervals if any will exist) should belong. "
  FilePath -> IO ()
putStrLn FilePath
"If you specify as the first one 2 (possibly the simplest case), then to the second one you can define a number in the range [3..53]. "
  FilePath -> IO ()
putStrLn FilePath
"If you specify as the first one 3, then to the second one you can define a number in the range [2..35]. "
  FilePath -> IO ()
putStrLn FilePath
"If you specify as the first one 4, then to the second one you can define a number in the range [2..26]. "
  FilePath -> IO ()
putStrLn FilePath
"If you specify as the first one 6, then to the second one you can define a number in the range [1..17]. "
  FilePath -> IO ()
putStrLn FilePath
"If you specify as the first one 9, then to the second one you can define a number in the range [1..11]. "
  FilePath
enka0 <- IO FilePath
getLine
  let enka1 :: [FilePath]
enka1 = Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
2 ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
x) (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
enka0
      enka2 :: Int
enka2 = FilePath -> Int
forall a. Read a => FilePath -> a
read ([FilePath] -> FilePath
forall a. [a] -> a
head ([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
1 ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int
      enka3 :: Int
enka3
        | Int
enka2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
53) Int
3 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Int
28 else (FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int)
           Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
53
        | Int
enka2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
35) Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Int
19 else (FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int)
           Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
35
        | Int
enka2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
26) Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Int
14 else (FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int)
           Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
26
        | Int
enka2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
17) Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Int
9 else (FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int)
           Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
17
        | Int
enka2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9 = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
11) Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Int
6 else (FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
forall a. [a] -> [a]
tail ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
enka1)::Int)
           Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
11
        | Bool
otherwise  = FilePath -> Int
forall a. HasCallStack => FilePath -> a
error FilePath
"Not valid number in the second place. "
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
enka2 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
enka3 ) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD3)
{-# INLINE processD_1 #-}

processD0 :: FilePath -> IO String
processD0 :: FilePath -> IO FilePath
processD0 FilePath
file = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (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
"x.wav", FilePath
"-r22050", FilePath
"channels", FilePath
"1"] FilePath
"" IO (ExitCode, FilePath, FilePath) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
putStrLn FilePath
"" IO () -> 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
"") (do
  Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
"x.wav"
  if Bool
exist then FilePath -> IO ()
removeFile FilePath
"x.wav"
  else FilePath -> IO ()
putStr FilePath
""
  FilePath -> IO ()
putStrLn FilePath
""
  FilePath -> IO ()
putStr FilePath
"The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. "
  FilePath -> IO ()
putStrLn FilePath
"Interrupt the program and start again with the valid file. "
  FilePath -> IO ()
putStrLn FilePath
"_______________________________________________________________________"
  FilePath -> IO FilePath
processD0 FilePath
file)
{-# INLINE processD0 #-}
  
processD1 :: IO String
processD1 :: IO FilePath
processD1 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  --tempeRa 0
  FilePath -> IO ()
putStrLn FilePath
"Please, specify, how many seconds long sound data you would like to record."
  FilePath
time <- IO FilePath
getLine
  let time0 :: Float
time0 = FilePath -> Float
forall a. Read a => FilePath -> a
read ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
t -> Char -> Bool
isDigit Char
t Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
time)::Float
  FilePath -> IO ()
putStrLn FilePath
"Please, wait for 0.5 second and produce the needed sound now."
  {- The following sample of code is taken from the recA function of the SoXBasics module in the @mmsyn7ukr@ package. -}
  if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"sox") Bool -> Bool -> Bool
&& Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
5 FilePath
os FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"mingw" 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
"-t",FilePath
"waveaudio",FilePath
"-d",FilePath
"-b16", FilePath
"-c1", FilePath
"-esigned-integer", FilePath
"-L", FilePath
"x.wav", FilePath
"trim", FilePath
"0.5", Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
time0 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0] FilePath
""
   if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- FilePath -> IO Bool
doesFileExist FilePath
"x.wav"
      if Bool
e0
        then do
          FilePath -> IO ()
removeFile FilePath
"x.wav"
          FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotRecorded FilePath
"x.wav")
        else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotRecorded FilePath
"x.wav")
     else do
      Bool
e1 <- FilePath -> IO Bool
doesFileExist FilePath
"x.wav"
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotRecorded FilePath
"x.wav")
  else if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe FilePath
showE FilePath
"rec") 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
"rec")) [FilePath
"-b16", FilePath
"-c1", FilePath
"-esigned-integer", FilePath
"-L", FilePath
"x.wav", FilePath
"trim", FilePath
"0.5", Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
time0 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0] FilePath
""
   if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
    then do
      Bool
e0 <- FilePath -> IO Bool
doesFileExist FilePath
"x.wav"
      if Bool
e0
        then do
          FilePath -> IO ()
removeFile FilePath
"x.wav"
          FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotRecorded FilePath
"x.wav")
        else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotRecorded FilePath
"x.wav")
    else do
      Bool
e1 <- FilePath -> IO Bool
doesFileExist FilePath
"x.wav"
      if Bool
e1
        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else FinalException -> IO ()
catchEnd (FilePath -> FinalException
NotRecorded FilePath
"x.wav")
   else FinalException -> IO ()
catchEnd FinalException
ExecutableNotProperlyInstalled -- End of the sample code for 'recA'
  FilePath -> IO ()
putStrLn FilePath
""
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"") (do
    [FilePath]
dir0 <- 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
== FilePath
"x.wav") [FilePath]
dir0
    (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
    FilePath -> IO ()
putStrLn FilePath
""
    IO ()
failureNotification 
    IO FilePath
processD1)
{-# INLINE processD1 #-}

processD3 :: IO String
processD3 :: IO FilePath
processD3 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStr FilePath
"Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) "
  FilePath -> IO ()
putStrLn FilePath
"should belong. The number should be better in the range [1..8]"
  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d3H IO FilePath
getLine) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD3)
{-# INLINE processD3 #-}

d3H :: String -> String
d3H :: FilePath -> FilePath
d3H FilePath
xs = Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
xs)::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
9
{-# INLINE d3H #-}

processD4 :: IO String
processD4 :: IO FilePath
processD4 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStr FilePath
"Please, specify the amplitude for the generated overtones as an Int number in the range [0..99]. "
  FilePath -> IO ()
putStrLn FilePath
"The default one is 99"
  FilePath -> IO ()
putStrLn FilePath
"To use the default value, you can simply press Enter."
  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d4H IO FilePath
getLine) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD4)
{-# INLINE processD4 #-}

d4H :: String -> String
d4H :: FilePath -> FilePath
d4H FilePath
xs
 | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs = FilePath
"1.0"
 | Bool
otherwise = let amplOb :: Int
amplOb = (FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
xs)::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
100 in
    case Int
amplOb of
      Int
99 -> FilePath
"1.0"
      Int
_ -> if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int
amplOb Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
9) Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then FilePath
"0.0" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
amplOb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
           else FilePath
"0." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
amplOb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE d4H #-}

processD5 :: IO String
processD5 :: IO FilePath
processD5 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStr FilePath
"Please, specify the basic duration for the generated sounds as a Float number in the range [0.1..4.0]. "
  FilePath -> IO ()
putStrLn FilePath
"The default one is 0.5"
  FilePath -> IO ()
putStrLn FilePath
"To use the default value, you can simply press Enter."
  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d5H IO FilePath
getLine) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD5)
{-# INLINE processD5 #-}

d5H :: String -> String
d5H :: FilePath -> FilePath
d5H FilePath
xs
  | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs = FilePath
"0.5"
  | Bool
otherwise = let time1 :: Float
time1 = (FilePath -> Float
forall a. Read a => FilePath -> a
read ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
z -> Char -> Bool
isDigit Char
z Bool -> Bool -> Bool
|| Char
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
xs)::Float) in
      if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
time1 Float
0.1 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
time1 Float
4.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT then Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
time1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0
      else let mantissa :: Float
mantissa = Float
time1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
time1)
               ceilP :: Int
ceilP    = (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
time1::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4 in
             if Int
ceilP Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then FilePath
"0." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
mantissa (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0)
             else Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ceilP FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
mantissa (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0)
{-# INLINE d5H #-}

processD7 :: IO String
processD7 :: IO FilePath
processD7 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStrLn FilePath
"Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: "
  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d7H IO FilePath
getLine) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
    IO FilePath
processD7)
{-# INLINE processD7 #-}

d7H :: String -> String
d7H :: FilePath -> FilePath
d7H FilePath
xs
  | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs = FilePath
"або"
  | Bool
otherwise = FilePath
xs
{-# INLINE d7H #-}

processD8 :: IO String
processD8 :: IO FilePath
processD8 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStr FilePath
"Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. "
  FilePath -> IO ()
putStrLn FilePath
"The number is in the range [0.1..2.0]. The default one is 1.0"
  FilePath -> IO ()
putStrLn FilePath
"To use the default value, you can simply press Enter."
  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d8H IO FilePath
getLine) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD8)
{-# INLINE processD8 #-}

d8H :: String -> String
d8H :: FilePath -> FilePath
d8H FilePath
xs
  | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs = FilePath
"1.0"
  | Bool
otherwise = let dAmpl1 :: Float
dAmpl1 = (FilePath -> Float
forall a. Read a => FilePath -> a
read ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
z -> Char -> Bool
isDigit Char
z Bool -> Bool -> Bool
|| Char
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
xs)::Float) in
    if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
dAmpl1 Float
0.1 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
dAmpl1 Float
2.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT then Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
dAmpl1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0
    else let mantissa :: Float
mantissa = Float
dAmpl1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
dAmpl1)
             ceilP :: Int
ceilP    = (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
dAmpl1::Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2 in
           if Int
ceilP Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then FilePath
"0." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
mantissa (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0)
           else Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ceilP FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Maybe Int -> Float -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
mantissa (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
0)
{-# INLINE d8H #-}

processD9 :: IO String
processD9 :: IO FilePath
processD9 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStrLn FilePath
"Please, input the Ukrainian text that will be used to define the intervals to be used to produce the lower note for the given main one. "
  FilePath -> IO ()
putStrLn FilePath
"The default one is \"й\". "
  FilePath -> IO ()
putStrLn FilePath
"To use the default value, you can simply press Enter."
  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d9H IO FilePath
getLine) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD9)
{-# INLINE processD9 #-}

d9H :: String -> String
d9H :: FilePath -> FilePath
d9H FilePath
xs
  | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs = FilePath
"й"
  | Bool
otherwise = FilePath
xs
{-# INLINE d9H #-}

processD :: IO String
processD :: IO FilePath
processD = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStrLn FilePath
"Please, input the Ukrainian text that will be used to create a special timbre for the notes: "
  IO FilePath
getLine) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD)
{-# INLINE processD #-}

processD99 :: IO String
processD99 :: IO FilePath
processD99 = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do
  FilePath -> IO ()
putStr FilePath
"Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indices for the files to be played "
  FilePath -> IO ()
putStr FilePath
"with SoX effects applied to. The lists must be separated with newline (just press \"Enter\"), empty lists are ignored. If index is an "
  FilePath -> IO ()
putStrLn FilePath
"element of several input lists then if its number of occurrences in all the lists is odd, then it is played, otherwise it is not. "
  FilePath -> IO ()
putStrLn FilePath
"To end the input, just press the combination that means the end of input (e. g. for Unices, it's probably Ctrl + D). "
  IO FilePath
getContents) (IO ()
failureNotification IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath
processD)
{-# INLINE processD99 #-}

----------------------------------------------------------------------------------------------