-- |
-- 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 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