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

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

module DobutokO.Sound.Effects.Biquad 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)

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

data Coeffs a = BQ3 a a a deriving Coeffs a -> Coeffs a -> Bool
(Coeffs a -> Coeffs a -> Bool)
-> (Coeffs a -> Coeffs a -> Bool) -> Eq (Coeffs a)
forall a. Eq a => Coeffs a -> Coeffs a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coeffs a -> Coeffs a -> Bool
$c/= :: forall a. Eq a => Coeffs a -> Coeffs a -> Bool
== :: Coeffs a -> Coeffs a -> Bool
$c== :: forall a. Eq a => Coeffs a -> Coeffs a -> Bool
Eq

instance Show (Coeffs Float) where
  show :: Coeffs Float -> String
show (BQ3 Float
x0 Float
x1 Float
x2) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x0 String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x1 String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x2 String
" "]

type BiQuad3 = Coeffs Float

coeffs1 :: Int -> Coeffs a -> Maybe a
coeffs1 :: Int -> Coeffs a -> Maybe a
coeffs1 Int
n (BQ3 a
x0 a
x1 a
x2) 
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
4 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = 
     case Int
n of 
      Int
1 -> a -> Maybe a
forall a. a -> Maybe a
Just a
x0
      Int
2 -> a -> Maybe a
forall a. a -> Maybe a
Just a
x1
      Int
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x2
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

coeffsSet1 :: a -> Coeffs a -> Coeffs a
coeffsSet1 :: a -> Coeffs a -> Coeffs a
coeffsSet1 a
x0 (BQ3 a
_ a
x1 a
x2) = a -> a -> a -> Coeffs a
forall a. a -> a -> a -> Coeffs a
BQ3 a
x0 a
x1 a
x2

coeffsSet2 :: a -> Coeffs a -> Coeffs a
coeffsSet2 :: a -> Coeffs a -> Coeffs a
coeffsSet2 a
x1 (BQ3 a
x0 a
_ a
x2) = a -> a -> a -> Coeffs a
forall a. a -> a -> a -> Coeffs a
BQ3 a
x0 a
x1 a
x2

coeffsSet3 :: a -> Coeffs a -> Coeffs a
coeffsSet3 :: a -> Coeffs a -> Coeffs a
coeffsSet3 a
x2 (BQ3 a
x0 a
x1 a
_) = a -> a -> a -> Coeffs a
forall a. a -> a -> a -> Coeffs a
BQ3 a
x0 a
x1 a
x2

data Biquad a = BQ (Coeffs a) (Coeffs a) deriving Biquad a -> Biquad a -> Bool
(Biquad a -> Biquad a -> Bool)
-> (Biquad a -> Biquad a -> Bool) -> Eq (Biquad a)
forall a. Eq a => Biquad a -> Biquad a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Biquad a -> Biquad a -> Bool
$c/= :: forall a. Eq a => Biquad a -> Biquad a -> Bool
== :: Biquad a -> Biquad a -> Bool
$c== :: forall a. Eq a => Biquad a -> Biquad a -> Bool
Eq

instance Show (Biquad Float) where
  show :: Biquad Float -> String
show (BQ Coeffs Float
x Coeffs Float
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"biquad ",Coeffs Float -> String
forall a. Show a => a -> String
show Coeffs Float
x, Coeffs Float -> String
forall a. Show a => a -> String
show Coeffs Float
y]

type BiQuad6 = Biquad Float

biquad1 :: Biquad a -> Coeffs a
biquad1 :: Biquad a -> Coeffs a
biquad1 (BQ Coeffs a
x Coeffs a
_) = Coeffs a
x

biquad2 :: Biquad a -> Coeffs a
biquad2 :: Biquad a -> Coeffs a
biquad2 (BQ Coeffs a
_ Coeffs a
y) = Coeffs a
y

biquadSet1 :: Coeffs a -> Biquad a -> Biquad a
biquadSet1 :: Coeffs a -> Biquad a -> Biquad a
biquadSet1 Coeffs a
x (BQ Coeffs a
_ Coeffs a
y) = Coeffs a -> Coeffs a -> Biquad a
forall a. Coeffs a -> Coeffs a -> Biquad a
BQ Coeffs a
x Coeffs a
y

biquadSet2 :: Coeffs a -> Biquad a -> Biquad a
biquadSet2 :: Coeffs a -> Biquad a -> Biquad a
biquadSet2 Coeffs a
y (BQ Coeffs a
x Coeffs a
_) = Coeffs a -> Coeffs a -> Biquad a
forall a. Coeffs a -> Coeffs a -> Biquad a
BQ Coeffs a
x Coeffs a
y

showBQ6Q :: BiQuad6 -> [String]
showBQ6Q :: Biquad Float -> [String]
showBQ6Q = String -> [String]
words (String -> [String])
-> (Biquad Float -> String) -> Biquad Float -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Biquad Float -> String
forall a. Show a => a -> String
show