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

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

module DobutokO.Sound.Effects.Phaser 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.Effects.Modulation2

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

data Phaser a b = Ph a a a a a b deriving Phaser a b -> Phaser a b -> Bool
(Phaser a b -> Phaser a b -> Bool)
-> (Phaser a b -> Phaser a b -> Bool) -> Eq (Phaser a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Phaser a b -> Phaser a b -> Bool
/= :: Phaser a b -> Phaser a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Phaser a b -> Phaser a b -> Bool
== :: Phaser a b -> Phaser a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Phaser a b -> Phaser a b -> Bool
Eq

instance Show (Phaser Float Modulation) where 
  show :: Phaser Float Modulation -> String
show (Ph Float
gainin Float
gainout Float
delay Float
decay Float
speed Modulation
mod1) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"phaser ",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
gainin String
" ",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing  Float
gainout String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
delay String
" ",
    Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
decay String
" ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
speed String
" ", Modulation -> String
forall a. Show a => a -> String
show Modulation
mod1]

type Phaser2 = Phaser Float Modulation

phaser1 :: Int -> Phaser a b -> a
phaser1 :: Int -> Phaser a b -> a
phaser1 Int
n (Ph a
x0 a
x1 a
x2 a
x3 a
x4 b
_) 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a
x0
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = a
x1
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = a
x2
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = a
x3
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = a
x4
  | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Phaser.phaser1: Not defined parameter. "
  
phaser2 :: Phaser a b -> b
phaser2 :: Phaser a b -> b
phaser2 (Ph a
_ a
_ a
_ a
_ a
_ b
y) = b
y

phaserSet1 :: Int -> a -> Phaser a b -> Phaser a b
phaserSet1 :: Int -> a -> Phaser a b -> Phaser a b
phaserSet1 Int
n a
x (Ph a
x0 a
x1 a
x2 a
x3 a
x4 b
y) 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = a -> a -> a -> a -> a -> b -> Phaser a b
forall a b. a -> a -> a -> a -> a -> b -> Phaser a b
Ph a
x a
x1 a
x2 a
x3 a
x4 b
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = a -> a -> a -> a -> a -> b -> Phaser a b
forall a b. a -> a -> a -> a -> a -> b -> Phaser a b
Ph a
x0 a
x a
x2 a
x3 a
x4 b
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = a -> a -> a -> a -> a -> b -> Phaser a b
forall a b. a -> a -> a -> a -> a -> b -> Phaser a b
Ph a
x0 a
x1 a
x a
x3 a
x4 b
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = a -> a -> a -> a -> a -> b -> Phaser a b
forall a b. a -> a -> a -> a -> a -> b -> Phaser a b
Ph a
x0 a
x1 a
x2 a
x a
x4 b
y
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = a -> a -> a -> a -> a -> b -> Phaser a b
forall a b. a -> a -> a -> a -> a -> b -> Phaser a b
Ph a
x0 a
x1 a
x2 a
x3 a
x b
y
  | Bool
otherwise = String -> Phaser a b
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Effects.Phaser.phaserSet1: Not defined parameter. "

phaserSet2 :: b -> Phaser a b -> Phaser a b
phaserSet2 :: b -> Phaser a b -> Phaser a b
phaserSet2 b
y (Ph a
x0 a
x1 a
x2 a
x3 a
x4 b
_) = a -> a -> a -> a -> a -> b -> Phaser a b
forall a b. a -> a -> a -> a -> a -> b -> Phaser a b
Ph a
x0 a
x1 a
x2 a
x3 a
x4 b
y

showPhQ :: Phaser2 -> [String]
showPhQ :: Phaser Float Modulation -> [String]
showPhQ = String -> [String]
words (String -> [String])
-> (Phaser Float Modulation -> String)
-> Phaser Float Modulation
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phaser Float Modulation -> String
forall a. Show a => a -> String
show