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

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

module DobutokO.Sound.Effects.Flanger 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.One

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

data ShapeInterp = S | T | L | Q deriving ShapeInterp -> ShapeInterp -> Bool
(ShapeInterp -> ShapeInterp -> Bool)
-> (ShapeInterp -> ShapeInterp -> Bool) -> Eq ShapeInterp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeInterp -> ShapeInterp -> Bool
$c/= :: ShapeInterp -> ShapeInterp -> Bool
== :: ShapeInterp -> ShapeInterp -> Bool
$c== :: ShapeInterp -> ShapeInterp -> Bool
Eq

instance Show ShapeInterp where
  show :: ShapeInterp -> String
show ShapeInterp
S = String
"s "
  show ShapeInterp
T = String
"t "
  show ShapeInterp
L = String
"l "
  show ShapeInterp
Q = String
"q "

data Flanger a b = FL [a] b deriving Flanger a b -> Flanger a b -> Bool
(Flanger a b -> Flanger a b -> Bool)
-> (Flanger a b -> Flanger a b -> Bool) -> Eq (Flanger a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Flanger a b -> Flanger a b -> Bool
/= :: Flanger a b -> Flanger a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Flanger a b -> Flanger a b -> Bool
== :: Flanger a b -> Flanger a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Flanger a b -> Flanger a b -> Bool
Eq

defaultList :: [Float]
defaultList :: [Float]
defaultList = [Float
0.0, Float
2.0, Float
0.0, Float
71.0, Float
0.5, Float
25.0]

flElem1 :: Int -> Float -> Float
flElem1 :: Int -> Float -> Float
flElem1 Int
n Float
x 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Float
0.0 else Float -> Float -> Float
toRange Float
30.0 (Float -> Float
forall a. Num a => a -> a
abs Float
x)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Float
0.0 else Float -> Float -> Float
toRange Float
10.0 (Float -> Float
forall a. Num a => a -> a
abs Float
x)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Float
0.0 else Float -> Float -> Float
toRange Float
95.0 Float
x
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Float
0.0 else Float -> Float -> Float
toRange Float
100.0 (Float -> Float
forall a. Num a => a -> a
abs Float
x)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = 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
forall a. Num a => a -> a
abs Float
x)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 then Float
0.0 else Float -> Float -> Float
toRange Float
100.0 (Float -> Float
forall a. Num a => a -> a
abs Float
x)
  | Bool
otherwise = String -> Float
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Flanger.flElem1: the Int parameter must be in the range [1..6]. "

listFlanger1 :: [Float] -> [Float]
listFlanger1 :: [Float] -> [Float]
listFlanger1 [Float]
xs 
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs) Int
6 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Float -> Float
flElem1 Int
i ([Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) [Int
1..Int
6]
  | Bool
otherwise = [[Float]] -> [Float]
forall a. Monoid a => [a] -> a
mconcat [(Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Float -> Float
flElem1 Int
i ([Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) [Int
1..[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs], Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs) [Float]
defaultList]

listFlanger15 :: [Float] -> [Float]
listFlanger15 :: [Float] -> [Float]
listFlanger15 [Float]
xs = Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
5 ([Float] -> [Float]) -> ([Float] -> [Float]) -> [Float] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
listFlanger1 ([Float] -> [Float]) -> [Float] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Float]
xs

listFlanger16 :: [Float] -> Float
listFlanger16 :: [Float] -> Float
listFlanger16 [Float]
xs = ([Float] -> [Float]
listFlanger1 [Float]
xs) [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! Int
5

instance Show (Flanger Float (One2 ShapeInterp)) where
  show :: Flanger Float (One2 ShapeInterp) -> String
show (FL [Float]
xs (O21 ShapeInterp
T)) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"flanger ", [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Float] -> [String]) -> [Float] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> String) -> [Float] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Float
t -> Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t String
" ") ([Float] -> [String])
-> ([Float] -> [Float]) -> [Float] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
listFlanger15 ([Float] -> String) -> [Float] -> String
forall a b. (a -> b) -> a -> b
$ [Float]
xs, ShapeInterp -> String
forall a. Show a => a -> String
show ShapeInterp
T, Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing ([Float] -> Float
listFlanger16 [Float]
xs) String
" "]
  show (FL [Float]
xs (O21 ShapeInterp
y)) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"flanger ", [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Float] -> [String]) -> [Float] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> String) -> [Float] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Float
t -> Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t String
" ") ([Float] -> [String])
-> ([Float] -> [Float]) -> [Float] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
listFlanger15 ([Float] -> String) -> [Float] -> String
forall a b. (a -> b) -> a -> b
$ [Float]
xs, ShapeInterp -> String
forall a. Show a => a -> String
show ShapeInterp
S, Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing ([Float] -> Float
listFlanger16 [Float]
xs) String
" ", 
     if ShapeInterp
y ShapeInterp -> ShapeInterp -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeInterp
S then String
"" else ShapeInterp -> String
forall a. Show a => a -> String
show ShapeInterp
y]
  show (FL [Float]
xs (O22 ShapeInterp
L ShapeInterp
x)) = Flanger Float (One2 ShapeInterp) -> String
forall a. Show a => a -> String
show ([Float] -> One2 ShapeInterp -> Flanger Float (One2 ShapeInterp)
forall a b. [a] -> b -> Flanger a b
FL [Float]
xs (ShapeInterp -> One2 ShapeInterp
forall a. a -> One2 a
O21 ShapeInterp
x))
  show (FL [Float]
xs (O22 ShapeInterp
S ShapeInterp
x)) = Flanger Float (One2 ShapeInterp) -> String
forall a. Show a => a -> String
show ([Float] -> One2 ShapeInterp -> Flanger Float (One2 ShapeInterp)
forall a b. [a] -> b -> Flanger a b
FL [Float]
xs (ShapeInterp -> One2 ShapeInterp
forall a. a -> One2 a
O21 ShapeInterp
x))
  show (FL [Float]
xs (O22 ShapeInterp
x ShapeInterp
L)) = Flanger Float (One2 ShapeInterp) -> String
forall a. Show a => a -> String
show ([Float] -> One2 ShapeInterp -> Flanger Float (One2 ShapeInterp)
forall a b. [a] -> b -> Flanger a b
FL [Float]
xs (ShapeInterp -> One2 ShapeInterp
forall a. a -> One2 a
O21 ShapeInterp
x))
  show (FL [Float]
xs (O22 ShapeInterp
x ShapeInterp
S)) = Flanger Float (One2 ShapeInterp) -> String
forall a. Show a => a -> String
show ([Float] -> One2 ShapeInterp -> Flanger Float (One2 ShapeInterp)
forall a b. [a] -> b -> Flanger a b
FL [Float]
xs (ShapeInterp -> One2 ShapeInterp
forall a. a -> One2 a
O21 ShapeInterp
x))
  show (FL [Float]
xs ~(O22 ShapeInterp
x ShapeInterp
y)) 
    | ShapeInterp
x ShapeInterp -> ShapeInterp -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeInterp
y = Flanger Float (One2 ShapeInterp) -> String
forall a. Show a => a -> String
show ([Float] -> One2 ShapeInterp -> Flanger Float (One2 ShapeInterp)
forall a b. [a] -> b -> Flanger a b
FL [Float]
xs (ShapeInterp -> One2 ShapeInterp
forall a. a -> One2 a
O21 ShapeInterp
x))
    | Bool
otherwise = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"flanger ", [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Float] -> [String]) -> [Float] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> String) -> [Float] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Float
t -> Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
t String
" ") ([Float] -> [String])
-> ([Float] -> [Float]) -> [Float] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
listFlanger15 ([Float] -> String) -> [Float] -> String
forall a b. (a -> b) -> a -> b
$ [Float]
xs, ShapeInterp -> String
forall a. Show a => a -> String
show ShapeInterp
T, Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing ([Float] -> Float
listFlanger16 [Float]
xs) String
" ",
        ShapeInterp -> String
forall a. Show a => a -> String
show ShapeInterp
Q]

type Flanger2 = Flanger Float (One2 ShapeInterp)

flanger1 :: Flanger a b -> [a]
flanger1 :: Flanger a b -> [a]
flanger1 (FL [a]
xs b
_) = [a]
xs

flanger2 :: Flanger a b -> b
flanger2 :: Flanger a b -> b
flanger2 (FL [a]
_ b
y) = b
y

flanger1E :: Flanger2 -> [Float]
flanger1E :: Flanger Float (One2 ShapeInterp) -> [Float]
flanger1E (FL [Float]
xs One2 ShapeInterp
_) = [Float] -> [Float]
listFlanger1 [Float]
xs

flangerSet1 :: [a] -> Flanger a b -> Flanger a b
flangerSet1 :: [a] -> Flanger a b -> Flanger a b
flangerSet1 [a]
xs (FL [a]
_ b
y) = [a] -> b -> Flanger a b
forall a b. [a] -> b -> Flanger a b
FL [a]
xs b
y

flangerSet2 :: b -> Flanger a b -> Flanger a b
flangerSet2 :: b -> Flanger a b -> Flanger a b
flangerSet2 b
y (FL [a]
xs b
_) = [a] -> b -> Flanger a b
forall a b. [a] -> b -> Flanger a b
FL [a]
xs b
y

showFLQ :: Flanger2 -> [String]
showFLQ :: Flanger Float (One2 ShapeInterp) -> [String]
showFLQ = String -> [String]
words (String -> [String])
-> (Flanger Float (One2 ShapeInterp) -> String)
-> Flanger Float (One2 ShapeInterp)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flanger Float (One2 ShapeInterp) -> String
forall a. Show a => a -> String
show