{-# 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 Data.List (intersperse)
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 Eq
instance Show ShapeInterp where
show S = "s "
show T = "t "
show L = "l "
show Q = "q "
data Flanger a b = FL [a] b deriving Eq
defaultList :: [Float]
defaultList = [0.0, 2.0, 0.0, 71.0, 0.5, 25.0]
flElem1 :: Int -> Float -> Float
flElem1 n x
| n == 1 = if x == 0.0 then 0.0 else toRange 30.0 (abs x)
| n == 2 = if x == 0.0 then 0.0 else toRange 10.0 (abs x)
| n == 3 = if x == 0.0 then 0.0 else toRange 95.0 x
| n == 4 = if x == 0.0 then 0.0 else toRange 100.0 (abs x)
| n == 5 = if compare (toRange 10.0 . abs $ x) 0.1 == LT then 0.1 else toRange 10.0 (abs x)
| n == 6 = if x == 0.0 then 0.0 else toRange 100.0 (abs x)
| otherwise = error "DobutokO.Sound.Effects.Flanger.flElem1: the Int parameter must be in the range [1..6]. "
listFlanger1 :: [Float] -> [Float]
listFlanger1 xs
| compare (length xs) 6 == GT = map (\i -> flElem1 i (xs !! (i - 1))) [1..6]
| otherwise = mconcat [map (\i -> flElem1 i (xs !! (i - 1))) [1..length xs], drop (length xs) defaultList]
listFlanger15 :: [Float] -> [Float]
listFlanger15 xs = take 5 . listFlanger1 $ xs
listFlanger16 :: [Float] -> Float
listFlanger16 xs = (listFlanger1 xs) !! 5
instance Show (Flanger Float (One2 ShapeInterp)) where
show (FL xs (O21 T)) = mconcat ["flanger ", mconcat . map (\t -> showFFloat Nothing t " ") . listFlanger15 $ xs, show T, showFFloat Nothing (listFlanger16 xs) " "]
show (FL xs (O21 y)) = mconcat ["flanger ", mconcat . map (\t -> showFFloat Nothing t " ") . listFlanger15 $ xs, show S, showFFloat Nothing (listFlanger16 xs) " ",
if y == S then "" else show y]
show (FL xs (O22 L x)) = show (FL xs (O21 x))
show (FL xs (O22 S x)) = show (FL xs (O21 x))
show (FL xs (O22 x L)) = show (FL xs (O21 x))
show (FL xs (O22 x S)) = show (FL xs (O21 x))
show (FL xs ~(O22 x y))
| x == y = show (FL xs (O21 x))
| otherwise = mconcat ["flanger ", mconcat . map (\t -> showFFloat Nothing t " ") . listFlanger15 $ xs, show T, showFFloat Nothing (listFlanger16 xs) " ",
show Q]
type Flanger2 = Flanger Float (One2 ShapeInterp)
flanger1 :: Flanger a b -> [a]
flanger1 (FL xs _) = xs
flanger2 :: Flanger a b -> b
flanger2 (FL _ y) = y
flanger1E :: Flanger2 -> [Float]
flanger1E (FL xs _) = listFlanger1 xs
flangerSet1 :: [a] -> Flanger a b -> Flanger a b
flangerSet1 xs (FL _ y) = FL xs y
flangerSet2 :: b -> Flanger a b -> Flanger a b
flangerSet2 y (FL xs _) = FL xs y
showFLQ :: Flanger2 -> [String]
showFLQ = words . show