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

{-# OPTIONS_GHC -threaded #-}

module DobutokO.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 Data.Maybe (fromJust)
import Data.Char (isDigit,isSpace)
import System.Process
import EndOfExe2 (showE)
import qualified Data.Vector as V (fromList)
import System.Directory
import Sound.SoXBasics
import SoXBasics.Arr (recA)
import Processing_mmsyn7ukr_array

-- | 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
2,FilePath -> IO FilePath
processD2 FilePath
file),(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)]

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]. "
  enka0 <- IO FilePath
getLine
  let 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 = FilePath -> Int
forall a. Read a => FilePath -> a
read ([FilePath] -> FilePath
forall a. HasCallStack => [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
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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
head ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. HasCallStack => [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. "
  return $ show enka2 ++ " " ++ show enka3 ) (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
"_______________________________________________________________________"
    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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
putStrLn FilePath
"" IO () -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"") (do
  exist <- FilePath -> IO Bool
doesFileExist FilePath
"x.wav"
  if exist then removeFile "x.wav"
  else putStr ""
  putStrLn ""
  putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. "
  putStrLn "Interrupt the program and start again with the valid file. "
  putStrLn "_______________________________________________________________________"
  processD0 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
  Int -> IO ()
tempeRa Int
0
  FilePath -> IO ()
putStrLn FilePath
"Please, specify, how many seconds long sound data you would like to record."
  time <- IO FilePath
getLine
  let 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
  putStrLn "Please, wait for 0.5 second and produce the needed sound now."
  recA "x.wav" time0
  putStrLn ""
  return "") (do
    dir0 <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
    let paths5 = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"nx.") [FilePath]
dir0
        paths6 = (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
        paths  = [FilePath]
paths5 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
paths6
    mapM_ removeFile paths
    putStrLn ""
    putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
    putStrLn "_______________________________________________________________________"
    processD1)
{-# INLINE processD1 #-}

processD2 :: FilePath -> IO String
processD2 :: FilePath -> IO FilePath
processD2 FilePath
file = IO FilePath -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO a
onException (do     
  exist3 <- FilePath -> IO Bool
doesFileExist FilePath
file
  if exist3 then return ""
  else do
    putStr "Please, specify the control parameter for the SoX \"noisered\" effect in the range from 0.0 to 1.0. "
    putStrLn "The greater value causes more reduction with possibly removing some important sound data. The default value is 0.5 "
    putStrLn "To use the default value, you can simply press Enter."
    ctrlN <- getLine
    let addit = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (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
t -> Char -> Bool
isDigit Char
t Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
ctrlN
        noiseP = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
ctrlN then FilePath
""
                 else FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
tail FilePath
addit
    controlNoiseReduction $ '0':noiseP 
    norm "_x.wav" 
    if "nx." `isPrefixOf` file 
      then putStr "" 
      else renameFile "8_x.wav" file 
    removeFile "x.wav" 
    removeFile "_x.wav" 
    dir <- listDirectory "." 
    let paths4 = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"nx.") [FilePath]
dir
    mapM_ removeFile paths4 
    putStrLn "" 
    return "") (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
"_______________________________________________________________________"
      FilePath -> IO FilePath
processD2 FilePath
file)
{-# INLINE processD2 #-}

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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d3H IO FilePath
getLine) (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
"_______________________________________________________________________"
    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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d4H IO FilePath
getLine) (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
"_______________________________________________________________________"
             IO FilePath
processD4)
{-# INLINE processD4 #-}

d4H :: String -> String
d4H :: FilePath -> FilePath
d4H FilePath
xs
 | FilePath -> Bool
forall a. [a] -> 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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d5H IO FilePath
getLine) (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
"_______________________________________________________________________"
             IO FilePath
processD5)
{-# INLINE processD5 #-}

d5H :: String -> String
d5H :: FilePath -> FilePath
d5H FilePath
xs
  | FilePath -> Bool
forall a. [a] -> 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 b. Integral b => Float -> b
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 b. Integral b => Float -> b
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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d7H IO FilePath
getLine) (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
"_______________________________________________________________________"
    IO FilePath
processD7)
{-# INLINE processD7 #-}

d7H :: String -> String
d7H :: FilePath -> FilePath
d7H FilePath
xs
  | FilePath -> Bool
forall a. [a] -> 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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d8H IO FilePath
getLine) (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
"_______________________________________________________________________"
             IO FilePath
processD8)
{-# INLINE processD8 #-}

d8H :: String -> String
d8H :: FilePath -> FilePath
d8H FilePath
xs
  | FilePath -> Bool
forall a. [a] -> 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 b. Integral b => Float -> b
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 b. Integral b => Float -> b
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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
d9H IO FilePath
getLine) (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
"_______________________________________________________________________"
    IO FilePath
processD9)
{-# INLINE processD9 #-}

d9H :: String -> String
d9H :: FilePath -> FilePath
d9H FilePath
xs
  | FilePath -> Bool
forall a. [a] -> 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) (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
"_______________________________________________________________________"
    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) (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
"_______________________________________________________________________"
    IO FilePath
processD)
{-# INLINE processD99 #-}

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