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

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

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

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

data NoiseType = Lipshitz | FWeighted | ModifiedEWeighted | ImprovedEWeighted | Gesemann | Shibata | LowShibata | HighShibata 
  deriving NoiseType -> NoiseType -> Bool
(NoiseType -> NoiseType -> Bool)
-> (NoiseType -> NoiseType -> Bool) -> Eq NoiseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoiseType -> NoiseType -> Bool
$c/= :: NoiseType -> NoiseType -> Bool
== :: NoiseType -> NoiseType -> Bool
$c== :: NoiseType -> NoiseType -> Bool
Eq
  
instance Show NoiseType where
  show :: NoiseType -> String
show NoiseType
Lipshitz = String
"lipshitz "
  show NoiseType
FWeighted = String
"f-weighted "
  show NoiseType
ModifiedEWeighted = String
"modified-e-weighted "
  show NoiseType
ImprovedEWeighted = String
"improved-e-weighted "
  show NoiseType
Gesemann = String
"gesemann "
  show NoiseType
Shibata = String
"shibata "
  show NoiseType
LowShibata = String
"low-shibata "
  show NoiseType
HighShibata = String
"high-shibata "

data Filter a = N | Ss | S | F a deriving Filter a -> Filter a -> Bool
(Filter a -> Filter a -> Bool)
-> (Filter a -> Filter a -> Bool) -> Eq (Filter a)
forall a. Eq a => Filter a -> Filter a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter a -> Filter a -> Bool
$c/= :: forall a. Eq a => Filter a -> Filter a -> Bool
== :: Filter a -> Filter a -> Bool
$c== :: forall a. Eq a => Filter a -> Filter a -> Bool
Eq

instance Show (Filter NoiseType) where
  show :: Filter NoiseType -> String
show Filter NoiseType
N = String
""
  show Filter NoiseType
S = String
"-S "
  show (F NoiseType
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-f ", NoiseType -> String
forall a. Show a => a -> String
show NoiseType
x]
  show Filter NoiseType
_ = String
"-s "

type FilterN = Filter NoiseType 

filterC :: Filter a -> String
filterC :: Filter a -> String
filterC Filter a
N = String
"N"
filterC Filter a
S = String
"S"
filterC Filter a
Ss = String
"Ss"
filterC Filter a
_ = String
"F"

filter1 :: Filter a -> Maybe a
filter1 :: Filter a -> Maybe a
filter1 (F a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
filter1 Filter a
_ = Maybe a
forall a. Maybe a
Nothing

filterN1 :: FilterN -> Maybe NoiseType
filterN1 :: Filter NoiseType -> Maybe NoiseType
filterN1 (F NoiseType
x) = NoiseType -> Maybe NoiseType
forall a. a -> Maybe a
Just NoiseType
x
filterN1 Filter NoiseType
Ss = NoiseType -> Maybe NoiseType
forall a. a -> Maybe a
Just NoiseType
Shibata
filterN1 Filter NoiseType
_ = Maybe NoiseType
forall a. Maybe a
Nothing

filterSet1 :: a -> Filter a
filterSet1 :: a -> Filter a
filterSet1 = a -> Filter a
forall a. a -> Filter a
F

data AutoD = A | N0 deriving AutoD -> AutoD -> Bool
(AutoD -> AutoD -> Bool) -> (AutoD -> AutoD -> Bool) -> Eq AutoD
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoD -> AutoD -> Bool
$c/= :: AutoD -> AutoD -> Bool
== :: AutoD -> AutoD -> Bool
$c== :: AutoD -> AutoD -> Bool
Eq

instance Show AutoD where
  show :: AutoD -> String
show AutoD
A = String
"-a "
  show AutoD
_ = String
""

autoDC :: AutoD -> String
autoDC :: AutoD -> String
autoDC AutoD
A = String
"A"
autoDC AutoD
_ =String
"N0"

data PrecisionD a = P a | N2 deriving PrecisionD a -> PrecisionD a -> Bool
(PrecisionD a -> PrecisionD a -> Bool)
-> (PrecisionD a -> PrecisionD a -> Bool) -> Eq (PrecisionD a)
forall a. Eq a => PrecisionD a -> PrecisionD a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrecisionD a -> PrecisionD a -> Bool
$c/= :: forall a. Eq a => PrecisionD a -> PrecisionD a -> Bool
== :: PrecisionD a -> PrecisionD a -> Bool
$c== :: forall a. Eq a => PrecisionD a -> PrecisionD a -> Bool
Eq

instance Show (PrecisionD Float) where
  show :: PrecisionD Float -> String
show PrecisionD Float
N2 = String
""
  show (P Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-p ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
24.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
1.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
1.0 else (Float -> Float -> Float
toRange Float
24.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)) String
" "]

type Precision = PrecisionD Float

precisionDC :: PrecisionD a -> String
precisionDC :: PrecisionD a -> String
precisionDC (P a
_) = String
"P"
precisionDC PrecisionD a
_ = String
"N2"

precisionD1 :: PrecisionD a -> Maybe a
precisionD1 :: PrecisionD a -> Maybe a
precisionD1 (P a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
precisionD1 PrecisionD a
_ = Maybe a
forall a. Maybe a
Nothing

precisionSet1 :: Float -> Precision
precisionSet1 :: Float -> PrecisionD Float
precisionSet1 Float
x = if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
24.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
1.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float -> PrecisionD Float
forall a. a -> PrecisionD a
P Float
1.0 else Float -> PrecisionD Float
forall a. a -> PrecisionD a
P (Float -> Float -> Float
toRange Float
24.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)

data Dither a b c = DT0 | DT100 a | DT010 b | DT001 c | DT011 b c | DT110 a b | DT101 a c | DT a b c deriving Dither a b c -> Dither a b c -> Bool
(Dither a b c -> Dither a b c -> Bool)
-> (Dither a b c -> Dither a b c -> Bool) -> Eq (Dither a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
Dither a b c -> Dither a b c -> Bool
/= :: Dither a b c -> Dither a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
Dither a b c -> Dither a b c -> Bool
== :: Dither a b c -> Dither a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
Dither a b c -> Dither a b c -> Bool
Eq

instance Show (Dither FilterN AutoD Precision) where
  show :: Dither (Filter NoiseType) AutoD (PrecisionD Float) -> String
show Dither (Filter NoiseType) AutoD (PrecisionD Float)
DT0 = String
"dither "
  show (DT100 Filter NoiseType
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dither ", Filter NoiseType -> String
forall a. Show a => a -> String
show Filter NoiseType
x]
  show (DT010 AutoD
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dither ", AutoD -> String
forall a. Show a => a -> String
show AutoD
y]
  show (DT001 PrecisionD Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dither ", PrecisionD Float -> String
forall a. Show a => a -> String
show PrecisionD Float
z]
  show (DT011 AutoD
y PrecisionD Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dither ", AutoD -> String
forall a. Show a => a -> String
show AutoD
y, PrecisionD Float -> String
forall a. Show a => a -> String
show PrecisionD Float
z]
  show (DT110 Filter NoiseType
x AutoD
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dither ", Filter NoiseType -> String
forall a. Show a => a -> String
show Filter NoiseType
x, AutoD -> String
forall a. Show a => a -> String
show AutoD
y]
  show (DT101 Filter NoiseType
x PrecisionD Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dither ", Filter NoiseType -> String
forall a. Show a => a -> String
show Filter NoiseType
x, PrecisionD Float -> String
forall a. Show a => a -> String
show PrecisionD Float
z]
  show (DT Filter NoiseType
x AutoD
y PrecisionD Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"dither ", Filter NoiseType -> String
forall a. Show a => a -> String
show Filter NoiseType
x, AutoD -> String
forall a. Show a => a -> String
show AutoD
y, PrecisionD Float -> String
forall a. Show a => a -> String
show PrecisionD Float
z]

type Dith = Dither FilterN AutoD Precision

ditherC :: Dither a b c -> String
ditherC :: Dither a b c -> String
ditherC Dither a b c
DT0 = String
"DT0"
ditherC (DT100 a
_) = String
"DT100"
ditherC (DT010 b
_) = String
"DT010"
ditherC (DT001 c
_) = String
"DT001"
ditherC (DT011 b
_ c
_) = String
"DT011"
ditherC (DT110 a
_ b
_) = String
"DT110"
ditherC (DT101 a
_ c
_) = String
"DT101"
ditherC Dither a b c
_ = String
"DT"

dither1 :: Dither a b c -> Maybe a
dither1 :: Dither a b c -> Maybe a
dither1 (DT100 a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
dither1 (DT101 a
x c
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
dither1 (DT110 a
x b
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
dither1 (DT a
x b
_ c
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
dither1 Dither a b c
_ = Maybe a
forall a. Maybe a
Nothing

dither2 :: Dither a b c -> Maybe b
dither2 :: Dither a b c -> Maybe b
dither2 (DT010 b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
dither2 (DT011 b
y c
_) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
dither2 (DT110 a
_ b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
dither2 (DT a
_ b
y c
_) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
dither2 Dither a b c
_ = Maybe b
forall a. Maybe a
Nothing

dither3 :: Dither a b c -> Maybe c
dither3 :: Dither a b c -> Maybe c
dither3 (DT001 c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
dither3 (DT101 a
_ c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
dither3 (DT011 b
_ c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
dither3 (DT a
_ b
_ c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
dither3 Dither a b c
_ = Maybe c
forall a. Maybe a
Nothing

ditherSet1 :: a -> Dither a b c -> Dither a b c
ditherSet1 :: a -> Dither a b c -> Dither a b c
ditherSet1 a
x (DT010 b
y) = a -> b -> Dither a b c
forall a b c. a -> b -> Dither a b c
DT110 a
x b
y
ditherSet1 a
x (DT001 c
z) = a -> c -> Dither a b c
forall a b c. a -> c -> Dither a b c
DT101 a
x c
z
ditherSet1 a
x (DT011 b
y c
z) = a -> b -> c -> Dither a b c
forall a b c. a -> b -> c -> Dither a b c
DT a
x b
y c
z
ditherSet1 a
x (DT110 a
_ b
y) = a -> b -> Dither a b c
forall a b c. a -> b -> Dither a b c
DT110 a
x b
y
ditherSet1 a
x (DT101 a
_ c
z) = a -> c -> Dither a b c
forall a b c. a -> c -> Dither a b c
DT101 a
x c
z
ditherSet1 a
x (DT a
_ b
y c
z) = a -> b -> c -> Dither a b c
forall a b c. a -> b -> c -> Dither a b c
DT a
x b
y c
z
ditherSet1 a
x Dither a b c
_ = a -> Dither a b c
forall a b c. a -> Dither a b c
DT100 a
x

ditherSet2  :: b -> Dither a b c -> Dither a b c
ditherSet2 :: b -> Dither a b c -> Dither a b c
ditherSet2  b
y (DT100 a
x) = a -> b -> Dither a b c
forall a b c. a -> b -> Dither a b c
DT110 a
x b
y
ditherSet2  b
y (DT001 c
z) = b -> c -> Dither a b c
forall a b c. b -> c -> Dither a b c
DT011 b
y c
z
ditherSet2  b
y (DT011 b
_ c
z) = b -> c -> Dither a b c
forall a b c. b -> c -> Dither a b c
DT011 b
y c
z
ditherSet2  b
y (DT110 a
x b
_) = a -> b -> Dither a b c
forall a b c. a -> b -> Dither a b c
DT110 a
x b
y
ditherSet2  b
y (DT101 a
x c
z) = a -> b -> c -> Dither a b c
forall a b c. a -> b -> c -> Dither a b c
DT a
x b
y c
z
ditherSet2  b
y (DT a
x b
_ c
z) = a -> b -> c -> Dither a b c
forall a b c. a -> b -> c -> Dither a b c
DT a
x b
y c
z
ditherSet2  b
y Dither a b c
_ = b -> Dither a b c
forall a b c. b -> Dither a b c
DT010 b
y

ditherSet3  :: c -> Dither a b c -> Dither a b c
ditherSet3 :: c -> Dither a b c -> Dither a b c
ditherSet3  c
z (DT100 a
x) = a -> c -> Dither a b c
forall a b c. a -> c -> Dither a b c
DT101 a
x c
z
ditherSet3  c
z (DT010 b
y) = b -> c -> Dither a b c
forall a b c. b -> c -> Dither a b c
DT011 b
y c
z
ditherSet3  c
z (DT011 b
y c
_) = b -> c -> Dither a b c
forall a b c. b -> c -> Dither a b c
DT011 b
y c
z
ditherSet3  c
z (DT101 a
x c
_) = a -> c -> Dither a b c
forall a b c. a -> c -> Dither a b c
DT101 a
x c
z
ditherSet3  c
z (DT110 a
x b
y) = a -> b -> c -> Dither a b c
forall a b c. a -> b -> c -> Dither a b c
DT a
x b
y c
z
ditherSet3  c
z (DT a
x b
y c
_) = a -> b -> c -> Dither a b c
forall a b c. a -> b -> c -> Dither a b c
DT a
x b
y c
z
ditherSet3  c
z Dither a b c
_ = c -> Dither a b c
forall a b c. c -> Dither a b c
DT001 c
z

showDQ :: Dith -> [String]
showDQ :: Dither (Filter NoiseType) AutoD (PrecisionD Float) -> [String]
showDQ = String -> [String]
words (String -> [String])
-> (Dither (Filter NoiseType) AutoD (PrecisionD Float) -> String)
-> Dither (Filter NoiseType) AutoD (PrecisionD Float)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dither (Filter NoiseType) AutoD (PrecisionD Float) -> String
forall a. Show a => a -> String
show