-- |
-- Module      :  DobutokO.Sound.Effects.Vad
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Can be used for applying the SoX \"vad\" effect. 
-- 

{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP, FlexibleInstances #-}

module DobutokO.Sound.Effects.Vad where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import Numeric (showFFloat)
import DobutokO.Sound.ToRange
import DobutokO.Sound.Effects.Misc (MscS(..),mscS1)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

data VadP a = T1 a | T a | S1 a | G a | P1 a | B a | N a | N1 a | R a | F a | M1 a | M a | H1 a | L1 a | H a | L a deriving VadP a -> VadP a -> Bool
(VadP a -> VadP a -> Bool)
-> (VadP a -> VadP a -> Bool) -> Eq (VadP a)
forall a. Eq a => VadP a -> VadP a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VadP a -> VadP a -> Bool
$c/= :: forall a. Eq a => VadP a -> VadP a -> Bool
== :: VadP a -> VadP a -> Bool
$c== :: forall a. Eq a => VadP a -> VadP a -> Bool
Eq

instance Show (VadP Float) where
  show :: VadP Float -> String
show (T1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-t ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
20.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (T Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-T ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.01 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.01 else Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (S1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-s ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
4.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float -> Float -> Float
toRange Float
4.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (G Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-g ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (P1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-p ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
4.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (B Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-b ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
10.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float -> Float -> Float
toRange Float
10.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (N Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-N ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
10.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float -> Float -> Float
toRange Float
10.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (N1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-n ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
0.1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.001 else Float -> Float -> Float
toRange Float
0.1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (R Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-r ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
2.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (F Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-f ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
50.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
5.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
5.0 else Float -> Float -> Float
toRange Float
50.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (M1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-m ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.01 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.01 else Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (M Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-M ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
0.1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
0.1 else Float -> Float -> Float
toRange Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (H1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-h ", 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
x) String
" "]
  show (L1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-l ", 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
x) String
" "]
  show (H Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-H ", 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
x) String
" "]
  show (L Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-L ", 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
x) String
" "]

type VadP1 = VadP Float

vadPC :: VadP a -> String
vadPC :: VadP a -> String
vadPC (T1 a
_) = String
"T1"
vadPC (T a
_) = String
"T"
vadPC (S1 a
_) = String
"S1"
vadPC (G a
_) = String
"G"
vadPC (P1 a
_) = String
"P1"
vadPC (B a
_) = String
"B"
vadPC (N a
_) = String
"N"
vadPC (N1 a
_) = String
"N1"
vadPC (R a
_) = String
"R"
vadPC (F a
_) = String
"F"
vadPC (M1 a
_) = String
"M1"
vadPC (M a
_) = String
"M"
vadPC (H1 a
_) = String
"H1"
vadPC (L1 a
_) = String
"L1"
vadPC (H a
_) = String
"H"
vadPC (L a
_) = String
"L"

vadP1 :: VadP a -> a
vadP1 :: VadP a -> a
vadP1 (T1 a
x) = a
x
vadP1 (T a
x) = a
x
vadP1 (S1 a
x) = a
x
vadP1 (G a
x) = a
x
vadP1 (P1 a
x) = a
x
vadP1 (B a
x) = a
x
vadP1 (N a
x) = a
x
vadP1 (N1 a
x) = a
x
vadP1 (R a
x) = a
x
vadP1 (F a
x) = a
x
vadP1 (M1 a
x) = a
x
vadP1 (M a
x) = a
x
vadP1 (H1 a
x) = a
x
vadP1 (L1 a
x) = a
x
vadP1 (H a
x) = a
x
vadP1 (L a
x) = a
x

vadPSet1 :: a -> VadP a -> VadP a
vadPSet1 :: a -> VadP a -> VadP a
vadPSet1 a
x (T1 a
_) = a -> VadP a
forall a. a -> VadP a
T1 a
x
vadPSet1 a
x (T a
_) = a -> VadP a
forall a. a -> VadP a
T a
x
vadPSet1 a
x (S1 a
_) = a -> VadP a
forall a. a -> VadP a
S1 a
x
vadPSet1 a
x (G a
_) = a -> VadP a
forall a. a -> VadP a
G a
x
vadPSet1 a
x (P1 a
_) = a -> VadP a
forall a. a -> VadP a
P1 a
x
vadPSet1 a
x (B a
_) = a -> VadP a
forall a. a -> VadP a
B a
x
vadPSet1 a
x (N a
_) = a -> VadP a
forall a. a -> VadP a
N a
x
vadPSet1 a
x (N1 a
_) = a -> VadP a
forall a. a -> VadP a
N1 a
x
vadPSet1 a
x (R a
_) = a -> VadP a
forall a. a -> VadP a
R a
x
vadPSet1 a
x (F a
_) = a -> VadP a
forall a. a -> VadP a
F a
x
vadPSet1 a
x (M1 a
_) = a -> VadP a
forall a. a -> VadP a
M1 a
x
vadPSet1 a
x (M a
_) = a -> VadP a
forall a. a -> VadP a
M a
x
vadPSet1 a
x (H1 a
_) = a -> VadP a
forall a. a -> VadP a
H1 a
x
vadPSet1 a
x (L1 a
_) = a -> VadP a
forall a. a -> VadP a
L1 a
x
vadPSet1 a
x (H a
_) = a -> VadP a
forall a. a -> VadP a
H a
x
vadPSet1 a
x (L a
_) = a -> VadP a
forall a. a -> VadP a
L a
x

data Vad1 a = VD (MscS a) deriving Vad1 a -> Vad1 a -> Bool
(Vad1 a -> Vad1 a -> Bool)
-> (Vad1 a -> Vad1 a -> Bool) -> Eq (Vad1 a)
forall a. Eq a => Vad1 a -> Vad1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vad1 a -> Vad1 a -> Bool
$c/= :: forall a. Eq a => Vad1 a -> Vad1 a -> Bool
== :: Vad1 a -> Vad1 a -> Bool
$c== :: forall a. Eq a => Vad1 a -> Vad1 a -> Bool
Eq

instance Show (Vad1 VadP1) where
  show :: Vad1 (VadP Float) -> String
show (VD MscS (VadP Float)
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"vad ", MscS (VadP Float) -> String
forall a. Show a => a -> String
show MscS (VadP Float)
x]

type Vad = Vad1 VadP1

vad11 :: Vad1 a -> [a]
vad11 :: Vad1 a -> [a]
vad11 (VD MscS a
x) = MscS a -> [a]
forall a. MscS a -> [a]
mscS1 MscS a
x

vad1Set1 :: [a] -> Vad1 a -> Vad1 a
vad1Set1 :: [a] -> Vad1 a -> Vad1 a
vad1Set1 [a]
xs (VD (Msc [a]
_)) = MscS a -> Vad1 a
forall a. MscS a -> Vad1 a
VD ([a] -> MscS a
forall a. [a] -> MscS a
Msc [a]
xs)

showVDQ :: Vad -> [String]
showVDQ :: Vad1 (VadP Float) -> [String]
showVDQ = String -> [String]
words (String -> [String])
-> (Vad1 (VadP Float) -> String) -> Vad1 (VadP Float) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vad1 (VadP Float) -> String
forall a. Show a => a -> String
show