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

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

module DobutokO.Sound.Effects.Stretch 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 StretchP a = SR a a a deriving StretchP a -> StretchP a -> Bool
(StretchP a -> StretchP a -> Bool)
-> (StretchP a -> StretchP a -> Bool) -> Eq (StretchP a)
forall a. Eq a => StretchP a -> StretchP a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StretchP a -> StretchP a -> Bool
$c/= :: forall a. Eq a => StretchP a -> StretchP a -> Bool
== :: StretchP a -> StretchP a -> Bool
$c== :: forall a. Eq a => StretchP a -> StretchP a -> Bool
Eq

-- | the first argument can be less than 1.0 but it is not recommended. The default value is 20.0.
instance Show (StretchP Float) where
  show :: StretchP Float -> String
show (SR Float
x Float
y Float
z) = [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 -> Float
forall a. Num a => a -> a
abs Float
x) String
" lin ", 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
1.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
y) String
" ", 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.5 (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
z) String
" "] 

type StretchPF = StretchP Float

stretch1 :: StretchP a -> a
stretch1 :: StretchP a -> a
stretch1 (SR a
x a
_ a
_) = a
x

stretch2 :: StretchP a -> a
stretch2 :: StretchP a -> a
stretch2 (SR a
_ a
y a
_) = a
y

stretch3 :: StretchP a -> a
stretch3 :: StretchP a -> a
stretch3 (SR a
_ a
_ a
z) = a
z

stretchSet1 :: a -> StretchP a -> StretchP a
stretchSet1 :: a -> StretchP a -> StretchP a
stretchSet1 a
x (SR a
_ a
y a
z) = a -> a -> a -> StretchP a
forall a. a -> a -> a -> StretchP a
SR a
x a
y a
z

stretchSet2 :: a -> StretchP a -> StretchP a
stretchSet2 :: a -> StretchP a -> StretchP a
stretchSet2 a
y (SR a
x a
_ a
z) = a -> a -> a -> StretchP a
forall a. a -> a -> a -> StretchP a
SR a
x a
y a
z

stretchSet3 :: a -> StretchP a -> StretchP a
stretchSet3 :: a -> StretchP a -> StretchP a
stretchSet3 a
z (SR a
x a
y a
_) = a -> a -> a -> StretchP a
forall a. a -> a -> a -> StretchP a
SR a
x a
y a
z

data Stretch2 a b = SR21 a | SR22 a b deriving Stretch2 a b -> Stretch2 a b -> Bool
(Stretch2 a b -> Stretch2 a b -> Bool)
-> (Stretch2 a b -> Stretch2 a b -> Bool) -> Eq (Stretch2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Stretch2 a b -> Stretch2 a b -> Bool
/= :: Stretch2 a b -> Stretch2 a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Stretch2 a b -> Stretch2 a b -> Bool
== :: Stretch2 a b -> Stretch2 a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Stretch2 a b -> Stretch2 a b -> Bool
Eq

instance Show (Stretch2 Float StretchPF) where
  show :: Stretch2 Float (StretchP Float) -> String
show (SR21 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"stretch ", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
x) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then String
"0.001 " else Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
x) String
" "]
  show (SR22 Float
x StretchP Float
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"stretch ", if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
x) Float
0.001 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then String
"0.001 " else Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
x) String
" ", StretchP Float -> String
forall a. Show a => a -> String
show StretchP Float
y]

type Stretch = Stretch2 Float StretchPF

stretch2C :: Stretch2 a b -> String
stretch2C :: Stretch2 a b -> String
stretch2C (SR21 a
_) = String
"SR21"
stretch2C Stretch2 a b
_ = String
"SR22"

stretch21 :: Stretch2 a b -> a
stretch21 :: Stretch2 a b -> a
stretch21 (SR21 a
x) = a
x
stretch21 (SR22 a
x b
_) = a
x

stretch22 :: Stretch2 a b -> Maybe b
stretch22 :: Stretch2 a b -> Maybe b
stretch22 (SR22 a
_ b
y) = b -> Maybe b
forall a. a -> Maybe a
Just b
y
stretch22 Stretch2 a b
_ = Maybe b
forall a. Maybe a
Nothing

stretch2Set1 :: a -> Stretch2 a b -> Stretch2 a b
stretch2Set1 :: a -> Stretch2 a b -> Stretch2 a b
stretch2Set1 a
x (SR21 a
_) = a -> Stretch2 a b
forall a b. a -> Stretch2 a b
SR21 a
x
stretch2Set1 a
x (SR22 a
_ b
y) = a -> b -> Stretch2 a b
forall a b. a -> b -> Stretch2 a b
SR22 a
x b
y

stretch2Set2 :: b -> Stretch2 a b -> Stretch2 a b
stretch2Set2 :: b -> Stretch2 a b -> Stretch2 a b
stretch2Set2 b
y (SR21 a
x) = a -> b -> Stretch2 a b
forall a b. a -> b -> Stretch2 a b
SR22 a
x b
y
stretch2Set2 b
y (SR22 a
x b
_) = a -> b -> Stretch2 a b
forall a b. a -> b -> Stretch2 a b
SR22 a
x b
y

showSTRQ :: Stretch -> [String]
showSTRQ :: Stretch2 Float (StretchP Float) -> [String]
showSTRQ = String -> [String]
words (String -> [String])
-> (Stretch2 Float (StretchP Float) -> String)
-> Stretch2 Float (StretchP Float)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stretch2 Float (StretchP Float) -> String
forall a. Show a => a -> String
show