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

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

module DobutokO.Sound.Effects.Vol 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 VolType = N | A | P | D deriving VolType -> VolType -> Bool
(VolType -> VolType -> Bool)
-> (VolType -> VolType -> Bool) -> Eq VolType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VolType -> VolType -> Bool
$c/= :: VolType -> VolType -> Bool
== :: VolType -> VolType -> Bool
$c== :: VolType -> VolType -> Bool
Eq

instance Show VolType where
  show :: VolType -> String
show VolType
A = String
"amplitude "
  show VolType
P = String
"power "
  show VolType
D = String
"dB "
  show VolType
_ = String
""

data Vol2 a b = V1 a | V2 a b | V3 a b a deriving Vol2 a b -> Vol2 a b -> Bool
(Vol2 a b -> Vol2 a b -> Bool)
-> (Vol2 a b -> Vol2 a b -> Bool) -> Eq (Vol2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Vol2 a b -> Vol2 a b -> Bool
/= :: Vol2 a b -> Vol2 a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Vol2 a b -> Vol2 a b -> Bool
== :: Vol2 a b -> Vol2 a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Vol2 a b -> Vol2 a b -> Bool
Eq

instance Show (Vol2 Float VolType) where
  show :: Vol2 Float VolType -> String
show (V1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"vol ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" "]
  show (V2 Float
x VolType
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"vol ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" ", VolType -> String
forall a. Show a => a -> String
show VolType
y]
  show (V3 Float
x VolType
y Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"vol ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
" ", VolType -> String
forall a. Show a => a -> String
show VolType
y, 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
0.1 (Float -> Float
forall a. Num a => a -> a
abs Float
z)) String
" "]

type Vol = Vol2 Float VolType

volC :: Vol2 a b -> String
volC :: Vol2 a b -> String
volC (V1 a
_) = String
"V1"
volC (V2 a
_ b
_) = String
"V2"
volC (V3 a
_ b
_ a
_) = String
"V3"

vol1 :: Vol2 a b -> a
vol1 :: Vol2 a b -> a
vol1 (V1 a
x) = a
x
vol1 (V2 a
x b
_) = a
x
vol1 (V3 a
x b
_ a
_) = a
x

vol2 :: Vol2 a b -> Maybe b
vol2 :: Vol2 a b -> Maybe b
vol2 (V2 a
_ b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
vol2 (V3 a
_ b
y a
_) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
vol2 Vol2 a b
_ = Maybe b
forall a. Maybe a
Nothing

vol3 :: Vol2 a b -> Maybe a
vol3 :: Vol2 a b -> Maybe a
vol3 (V3 a
_ b
_ a
z) = a -> Maybe a
forall a. a -> Maybe a
Just a
z
vol3 Vol2 a b
_ = Maybe a
forall a. Maybe a
Nothing

volSet1 :: a -> Vol2 a b -> Vol2 a b
volSet1 :: a -> Vol2 a b -> Vol2 a b
volSet1 a
x (V1 a
_) = a -> Vol2 a b
forall a b. a -> Vol2 a b
V1 a
x
volSet1 a
x (V2 a
_ b
y) = a -> b -> Vol2 a b
forall a b. a -> b -> Vol2 a b
V2 a
x b
y
volSet1 a
x (V3 a
_ b
y a
z) = a -> b -> a -> Vol2 a b
forall a b. a -> b -> a -> Vol2 a b
V3 a
x b
y a
z

volSet2 :: b -> Vol2 a b -> Vol2 a b
volSet2 :: b -> Vol2 a b -> Vol2 a b
volSet2 b
y (V1 a
x) = a -> b -> Vol2 a b
forall a b. a -> b -> Vol2 a b
V2 a
x b
y
volSet2 b
y (V2 a
x b
_) = a -> b -> Vol2 a b
forall a b. a -> b -> Vol2 a b
V2 a
x b
y
volSet2 b
y (V3 a
x b
_ a
z) = a -> b -> a -> Vol2 a b
forall a b. a -> b -> a -> Vol2 a b
V3 a
x b
y a
z

volSet3 :: Float -> Vol -> Vol
volSet3 :: Float -> Vol2 Float VolType -> Vol2 Float VolType
volSet3 Float
x (V1 Float
x1) = Float -> VolType -> Float -> Vol2 Float VolType
forall a b. a -> b -> a -> Vol2 a b
V3 Float
x1 VolType
N Float
x
volSet3 Float
x (V2 Float
x1 VolType
y) = Float -> VolType -> Float -> Vol2 Float VolType
forall a b. a -> b -> a -> Vol2 a b
V3 Float
x1 VolType
y Float
x
volSet3 Float
x (V3 Float
x1 VolType
y Float
_) = Float -> VolType -> Float -> Vol2 Float VolType
forall a b. a -> b -> a -> Vol2 a b
V3 Float
x1 VolType
y Float
x

showVQ :: Vol -> [String]
showVQ :: Vol2 Float VolType -> [String]
showVQ = String -> [String]
words (String -> [String])
-> (Vol2 Float VolType -> String) -> Vol2 Float VolType -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vol2 Float VolType -> String
forall a. Show a => a -> String
show