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

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

module DobutokO.Sound.Effects.Contrast 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 DobutokO.Sound.ToRange
import Numeric (showFFloat)

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

data Contrast a = E | Ct a deriving Contrast a -> Contrast a -> Bool
(Contrast a -> Contrast a -> Bool)
-> (Contrast a -> Contrast a -> Bool) -> Eq (Contrast a)
forall a. Eq a => Contrast a -> Contrast a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contrast a -> Contrast a -> Bool
$c/= :: forall a. Eq a => Contrast a -> Contrast a -> Bool
== :: Contrast a -> Contrast a -> Bool
$c== :: forall a. Eq a => Contrast a -> Contrast a -> Bool
Eq

instance Show (Contrast Float) where
  show :: Contrast Float -> String
show Contrast Float
E = String
"contrast 75"
  show (Ct Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"contrast ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
100.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 Cntrst = Contrast Float

contrastC :: Contrast a -> String
contrastC :: Contrast a -> String
contrastC Contrast a
E = String
"E"
contrastC Contrast a
_ = String
"Ct"

contrast1 :: Contrast a -> Maybe a
contrast1 :: Contrast a -> Maybe a
contrast1 (Ct a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
contrast1 Contrast a
_ = Maybe a
forall a. Maybe a
Nothing

contrastE1 :: Cntrst -> Float
contrastE1 :: Contrast Float -> Float
contrastE1 (Ct Float
x) = Float
x
contrastE1 Contrast Float
E = Float
75.0

contrastSet1 :: a -> Contrast a -> Contrast a
contrastSet1 :: a -> Contrast a -> Contrast a
contrastSet1 a
x Contrast a
_ = a -> Contrast a
forall a. a -> Contrast a
Ct a
x

showCtQ :: Cntrst -> [String]
showCtQ :: Contrast Float -> [String]
showCtQ = String -> [String]
words (String -> [String])
-> (Contrast Float -> String) -> Contrast Float -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contrast Float -> String
forall a. Show a => a -> String
show